Changeset 37763 in project


Ignore:
Timestamp:
07/05/19 12:17:42 (4 months ago)
Author:
juergen
Message:

pseudolists: pl-for macro renamed pl-collect

Location:
release/5/pseudolists
Files:
9 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/5/pseudolists/tags/1.0/trunk/pseudolists.egg

    r37451 r37763  
    44 (license "BSD")
    55 (test-dependencies simple-tests)
    6  (author "[[Juergen Lorenz]]")
    7  (version "1.0")
     6 (author "Juergen Lorenz")
     7 (version "1.1")
    88 (components (extension pseudolists)))
    99
  • release/5/pseudolists/tags/1.0/trunk/pseudolists.scm

    r37451 r37763  
    3636   pl-null? pl-length pl-head pl-sentinel
    3737   pl-flatten pl-reverse
    38    pl-index pl-filter pl-map pl-memp pl-member
    39    pl-memq pl-memv pl-adjoin pl-remove-dups
     38   pl-index pl-filter pl-map
     39   pl-memp pl-member pl-memq pl-memv
     40   pl-adjoin pl-remove-dups
    4041   pl-at pl-drop pl-take pl-append
    4142   pl-drop-while pl-take-while
     
    4344   pl-fold-right0 pl-fold-left0
    4445   pl-for pseudolists
     46   Some-sentinel No-sentinel sentinel ;sentinel-option sentinel-option?
    4547   )
    4648
    4749  (import scheme
     50          datatype
    4851          (only (chicken base) cut case-lambda assert print error))
    4952
    50 (define (pl-maker sentinel . args)
     53(define (any? xpr) #t)
     54
     55(define-datatype sentinel-option sentinel-option?
     56  (Some-sentinel (x any?))
     57  (No-sentinel))
     58
     59(define (sentinel opt)
     60  (cases sentinel-option opt
     61    (Some-sentinel (x) x)
     62    (No-sentinel () '())))
     63
     64(define (pl-maker opt . args)
    5165  (let loop ((args args))
    5266    (if (null? args)
    53       sentinel
     67      (sentinel opt)
    5468      (cons (car args) (loop (cdr args))))))
    5569
    56 (define (pl-iterate sentinel times fn . inits)
     70(define (pl-iterate opt fn times . inits)
    5771  (cond
    5872    ((null? inits)
    5973     (lambda (x)
    60        (pl-iterate sentinel times fn x)))
     74       (pl-iterate opt fn times x)))
    6175    ((null? (cdr inits))
    6276     (let recur ((x (car inits)) (k 0))
    6377       (if (= k times)
    64          sentinel
     78         (sentinel opt)
    6579         (cons x (recur (fn x) (+ k 1))))))
    6680    (else 'pl-iterate "too many arguments")))
     
    96110
    97111(define (pl-sentinel pl)
    98   (if (pl-null? pl)
    99     pl
    100     (let ((rest (cdr pl)))
    101       (if (pl-null? rest)
    102         rest
    103         (pl-sentinel rest)))))
     112  (let loop ((pl pl))
     113    (if (pl-null? pl)
     114      pl
     115      (loop (cdr pl)))))
    104116
    105117(define (pl-head pl)
    106   (let ((len (pl-length pl)))
    107     (let recur ((k 0) (pl pl))
    108       (cond
    109         ((pl-null? pl) '())
    110         ((< k len)
    111          (cons (car pl) (recur (+ k 1) (cdr pl))))
    112         (else (recur (+ k 1) (cdr pl)))))))
    113 
    114 (define (pl-at n . pls)
    115   (cond
    116     ((null? pls)
     118  (let recur ((pl pl))
     119    (if (pl-null? pl)
     120      '()
     121      (cons (car pl) (recur (cdr pl))))))
     122
     123(define pl-at
     124  (case-lambda
     125    ((n)
    117126     (lambda (pl)
    118127       (pl-at n pl)))
    119     ((null? (cdr pls))
    120      (let ((pl (car pls)))
     128    ((n pl)
     129     (let ((pl pl))
    121130       (assert (< -1 n (pl-length pl)))
    122131       (let loop ((k 0) (pl pl))
     
    126135           (else
    127136             (loop (+ k 1) (cdr pl)))))))
    128     (else (error 'pl-at "too many arguments"))))
    129 
    130 (define (pl-drop n . pls)
    131   (cond
    132     ((null? pls)
     137    ))
     138
     139(define pl-drop
     140  (case-lambda
     141    ((n)
    133142     (lambda (pl)
    134143       (pl-drop n pl)))
    135     ((null? (cdr pls))
    136      (let ((pl (car pls)))
     144    ((n pl)
     145     (let ((pl pl))
    137146       (assert (or (pl-null? pl) (< -1 n (pl-length pl))))
    138147       (let loop ((n n) (pl pl))
     
    142151           (else
    143152             (loop (- n 1) (cdr pl)))))))
    144     (else (error 'pl-drop "too many arguments"))
    145     ))
    146 
    147 (define (pl-drop-while ok? . pls)
    148   (cond
    149     ((null? pls)
     153    ))
     154
     155(define pl-drop-while
     156  (case-lambda
     157    ((ok?)
    150158     (lambda (pl)
    151159       (pl-drop-while ok? pl)))
    152     ((null? (cdr pls))
    153        (let loop ((pl (car pls)))
    154          (if (pl-null? pl)
    155            pl
    156            (let ((first (car pl)) (rest (cdr pl)))
    157              (if (ok? first)
    158                (loop rest)
    159                pl)))))
    160     (else (error 'pl-drop-while "too many arguments"))
    161     ))
    162 
    163 (define (pl-take n . pls)
    164   (cond
    165     ((null? pls)
     160    ((ok? pl)
     161     (let loop ((pl pl))
     162       (if (pl-null? pl)
     163         pl
     164         (let ((first (car pl)) (rest (cdr pl)))
     165           (if (ok? first)
     166             (loop rest)
     167             pl)))))
     168    ))
     169
     170(define pl-take
     171  (case-lambda
     172    ((n)
    166173     (lambda (pl)
    167174       (pl-take n pl)))
    168     ((null? (cdr pls))
    169      (let ((pl (car pls)))
    170        (assert (or (pl-null? pl) (< -1 n (pl-length pl))))
    171        (let recur ((k 0) (pl pl))
    172          (cond
    173            ((pl-null? pl) pl)
    174            ((< k n)
    175             (cons (car pl) (recur (+ k 1) (cdr pl))))
    176            (else (recur (+ k 1) (cdr pl)))))))
    177     (else (error 'pl-take "too many arguments"))))
     175    ((n pl)
     176     (assert (or (pl-null? pl) (< -1 n (pl-length pl))))
     177     (let recur ((k 0) (pl pl))
     178       (cond
     179         ((pl-null? pl)
     180          pl)
     181         ((< k n)
     182          (cons (car pl) (recur (+ k 1) (cdr pl))))
     183         (else (recur (+ k 1) (cdr pl))))))
     184    ))
    178185     
    179 (define (pl-take-while ok? . pls)
    180   (cond
    181     ((null? pls)
     186(define pl-take-while
     187  (case-lambda
     188    ((ok?)
    182189     (lambda (pl)
    183190       (pl-take-while ok? pl)))
    184     ((null? (cdr pls))
    185      (let recur ((pl (car pls)))
     191    ((ok? pl)
     192     (let recur ((pl pl))
    186193       (if (pl-null? pl)
    187194         pl
     
    190197             (cons first (recur rest))
    191198             (recur rest))))))
    192     (else (error 'pl-take-while "too many arguments"))))
    193      
    194 (define (pl-reverse pl)
    195   (let loop ((pl pl) (result (pl-sentinel pl)))
     199    ))
     200
     201(define (pl-reverse opt pl)
     202  (let loop ((pl pl) (result (sentinel opt)))
    196203    (if (pl-null? pl)
    197204      result
    198205      (loop (cdr pl) (cons (car pl) result)))))
    199206
    200 (define (pl-map fn . pls)
    201   (cond
    202     ((null? pls)
    203      (lambda (pl)
    204        (pl-map fn pl)))
    205     ((null? (cdr pls))
    206      (let recur ((pl (car pls)))
    207        (if (pl-null? pl)
    208          pl
     207(define pl-map
     208  (case-lambda
     209    ((opt fn)
     210     (lambda (pl)
     211       (pl-map opt fn pl)))
     212    ((opt fn pl)
     213     (let recur ((pl pl))
     214       (if (pl-null? pl)
     215         (sentinel opt)
    209216         (cons (fn (car pl)) (recur (cdr pl))))))
    210     (else (error 'pl-map "too many arguments"))))
     217    ))
    211218
    212219(define (pl-memp ok? . pls)
     
    234241  (apply pl-memp (cut equal? <> x) pls))
    235242
    236 (define (pl-index ok? . pls)
    237   (cond
    238     ((null? pls)
     243(define pl-index
     244  (case-lambda
     245    ((ok?)
    239246     (lambda (pl)
    240247       (pl-index ok? pl)))
    241     ((null? (cdr pls))
    242      (let loop ((k 0) (pl (car pls)))
     248    ((ok? pl)
     249     (let loop ((k 0) (pl pl))
    243250       (cond
    244251         ((pl-null? pl) -1)
     
    246253         (else
    247254           (loop (+ k 1) (cdr pl))))))
    248     (else
    249       (error 'pl-index "too many arguments"))))
    250 
    251 (define (pl-filter ok? . pls)
    252   (cond
    253     ((null? pls)
     255    ))
     256
     257(define pl-filter
     258  (case-lambda
     259    ((ok?)
    254260     (lambda (pl)
    255261       (pl-filter ok? pl)))
    256     ((null? (cdr pls))
    257      (let recur ((pl (car pls)))
     262    ((ok? pl)
     263     (let recur ((pl pl))
    258264       (if (pl-null? pl)
    259265         pl
     
    262268             (cons first (recur rest))
    263269             (recur rest))))))
    264     (else
    265       (error 'pl-filter "too many arguments"))))
    266 
    267 (define (pl-append pl . pls)
     270    ))
     271
     272(define (pl-append opt pl . pls)
    268273  (cond
    269     ((null? pls) pl)
     274    ((null? pls); pl)
     275     (let recur ((pl pl))
     276       (if (pl-null? pl)
     277         (sentinel opt)
     278         (cons (car pl) (recur (cdr pl))))))
    270279    ((null? (cdr pls))
    271280     (let recur ((pl pl))
    272281       (if (pl-null? pl)
    273          (car pls)
     282         (pl-append opt (car pls))
    274283         (cons (car pl) (recur (cdr pl))))))
    275284    (else
    276       (pl-append pl (apply pl-append (car pls) (cdr pls))))))
    277 
    278 
    279 (define (pl-fold-right op init . pls)
    280   (cond
    281     ((null? pls)
     285      (pl-append opt pl (apply pl-append opt (car pls) (cdr pls))))))
     286
     287(define pl-fold-right
     288  (case-lambda
     289    ((op init)
    282290     (lambda (pl)
    283291       (pl-fold-right op init pl)))
    284     ((null? (cdr pls))
    285      (let recur ((pl (car pls)))
     292    ((op init pl)
     293     (let recur ((pl pl))
    286294       (if (pl-null? pl)
    287295         init
    288296         (op (car pl) (recur (cdr pl))))))
    289     (else (error 'pl-fold-right "too many arguments"))))
    290 
    291 (define (pl-fold-right0 op . pls)
    292   (cond
    293     ((null? pls)
     297    ))
     298
     299(define pl-fold-right0
     300  (case-lambda
     301    ((op)
    294302     (lambda (pl)
    295303       (pl-fold-right0 op pl)))
    296     ((null? (cdr pls))
    297      (let ((pl (car pls)))
     304    ((op pl)
     305     (let ((pl pl))
    298306       (if (pl-null? pl)
    299307         (error 'pl-fold-right0 "pseudolist empty" pl)
     
    301309    ))
    302310
    303 (define (pl-fold-left op init . pls)
    304   (cond
    305     ((null? pls)
     311(define pl-fold-left
     312  (case-lambda
     313    ((op init)
    306314     (lambda (pl)
    307315       (pl-fold-left op init pl)))
    308     ((null? (cdr pls))
    309      (let loop ((pl (car pls)) (result init))
     316    ((op init pl)
     317     (let loop ((pl pl) (result init))
    310318       (if (pl-null? pl)
    311319         result
    312320         (loop (cdr pl) (op result (car pl))))))
    313     (else (error 'pl-fold-left "too many arguments"))))
    314 
    315 (define (pl-fold-left0 op . pls)
    316   (cond
    317     ((null? pls)
     321    ))
     322
     323(define pl-fold-left0
     324  (case-lambda
     325    ((op)
    318326     (lambda (pl)
    319327       (pl-fold-left0 op pl)))
    320     ((null? (cdr pls))
    321      (let ((pl (car pls)))
     328    ((op pl)
     329     (let ((pl pl))
    322330       (if (pl-null? pl)
    323331         (error 'pl-fold-left0 "pseudolist empty" pl)
     
    325333    ))
    326334
    327 (define (pl-adjoin obj . pls)
    328   (cond
    329     ((null? pls)
     335(define pl-adjoin
     336  (case-lambda
     337    ((obj)
    330338     (lambda (pl)
    331339       (pl-adjoin obj pl)))
    332     ((null? (cdr pls))
    333      (let ((pl (car pls)))
     340    ((obj pl)
     341     (let ((pl pl))
    334342       (if (pair? (pl-member obj pl))
    335343         pl
    336344         (cons obj pl))))
    337     (else (error 'pl-adjoin "too many arguments"))))
     345    ))
    338346
    339347(define (pl-remove-dups pl)
     
    343351      (pl-adjoin (car pl) (recur (cdr pl))))))
    344352
    345 (define (pl-flatten tree)
    346   ; imported flatten doesn't work with pl-makers
    347   (let recur ((tree tree) (result '()))
    348     (cond
    349       ((pair? tree)
    350        (recur (car tree) (recur (cdr tree) result)))
    351       ((null? tree) result)
    352       (else
    353         (cons tree result)))))
    354 
    355 ;;; (pl-for ((var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...) item-xpr)
    356 ;;; ------------------------------------------------------------------
     353(define (pl-flatten opt pl-tree)
     354  (let recur ((tree pl-tree) (result (sentinel opt)))
     355    (if (pair? tree)
     356      (let ((head (car tree)) (tail (cdr tree)))
     357        (cond
     358          ((pair? head)
     359           (recur head (recur tail result)))
     360          (else
     361            (cons head (recur tail result)))))
     362      result)))
     363
     364;;; (pl-for ((var pl ok-xpr ...) ....) opt item-xpr)
     365;;; ------------------------------------------------
    357366(define-syntax pl-for
    358367  (syntax-rules ()
    359    ((_ ((var pl ok-xpr ...)) item-xpr)
     368   ;((_ ((var pl ok-xpr ...)) opt item-xpr)
     369   ((_ opt item-xpr (var pl ok-xpr ...))
    360370     (let recur ((seq pl))
    361371       (if (pl-null? seq)
    362          seq
     372         (sentinel opt)
    363373         (let ((var (car seq)))
    364374           (if (and ok-xpr ...)
    365375             (cons item-xpr (recur (cdr seq)))
    366376             (recur (cdr seq)))))))
    367     ((_ ((var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...) item-xpr)
    368      (let recur ((seq pl))
    369        (if (pl-null? seq)
    370          seq
    371          (let ((var (car seq)))
    372            (if (and ok-xpr ...)
    373              (pl-append (pl-for ((var1 pl1 ok-xpr1 ...) ...) item-xpr)
    374                         (recur (cdr seq)))
    375              (recur (cdr seq)))))))
    376     ))
     377   ;((_ ((var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
     378   ((_ opt item-xpr (var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...)
     379    (let recur ((seq pl))
     380      (if (pl-null? seq)
     381        (sentinel opt)
     382        (let ((var (car seq)))
     383          (if (and ok-xpr ...)
     384            (pl-append opt ;(pl-for ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
     385                       (pl-for opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
     386                       (recur (cdr seq)))
     387            (recur (cdr seq)))))))
     388   ))
    377389
    378390;;; (pseudolists sym ..)
     
    390402    (pl-maker
    391403      procedure:
    392         (pl-maker sentinel . args)
    393         "creates a new pseudolist from args"
    394         "and sentinel")
     404        (pl-maker opt . args)
     405        "creates a new pseudolist with (sentinel opt) from args")
    395406    (pl?
    396407      procedure:
     
    409420    (pl-iterate
    410421      procedure:
    411       (pl-iterate sentinel k fn)
    412       (pl-iterate sentinel k fn init)
    413       "creates a pseudolist with sentinel applying fn to int"
     422      (pl-iterate opt fn k)
     423      (pl-iterate opt fn k init)
     424      "creates a pseudolist with (sentinel opt) applying fn to int"
    414425      "recursively k times")
    415426    (pl-length
     
    447458        (pl-take n pl)
    448459        (pl-take pl)
    449         "returns the head of pl up to but excluding index n,"
     460        "returns the sublist of pl up to but excluding index n,"
    450461        "where n is less than or equal to pl's pl-length")
    451462    (pl-take-while
     
    453464        (pl-take-while pl)
    454465        (pl-take-while ok? pl)
    455         "returns the head of pl consisting of items"
     466        "returns the sublist of pl consisting of items"
    456467        "which pass the ok? test")
    457468    (pl-map
    458469      procedure:
    459         (pl-map fn pl)
    460         "maps fn over the pseudolist pl")
     470        (pl-map opt fn)
     471        (pl-map opt fn pl)
     472        "maps fn over the pseudolist pl"
     473        "and returns a new pseudolist with (sentinel opt)")
    461474    (pl-index
    462475      procedure:
     
    472485    (pl-reverse
    473486      procedure:
    474       (pl-reverse pl)
    475       "reverses its pseudolist argument")
     487      (pl-reverse opt pl)
     488      "reverses its pseudolist argument to a now one"
     489      "with (sentinel opt)")
    476490    (pl-append
    477491      procedure:
    478       (pl-append pl . pls)
    479       "appends all argument pseudolists")
     492      (pl-append opt pl . pls)
     493      "appends all argument pseudolists to a pseudolist"
     494      "with (sentinel opt)")
    480495    (pl-memp
    481496      procedure:
     
    530545    (pl-flatten
    531546      procedure:
    532         (pl-flatten tree)
    533         "flattens the nested pseudolist tree to a proper list")
     547        (pl-flatten opt pl-tree)
     548        "flattens the nested pseudolist tree to a"
     549        "pseudolist with (sentinel opt)")
    534550    (pl-for
    535551      macro:
    536       (pl-for ((var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...) xpr)
    537       "creates a new pseudolist by binding var to each element"
     552      (pl-for opt xpr (var pl ok-xpr ...) ....)
     553      "creates a new pseudolist with (sentinel opt) by binding var to each element"
    538554      "of the pseudolist pl in sequence, and if it passes the checks,"
    539555      "ok-xpr ..., inserts the value of xpr into the resulting pseudolist."
     
    555571
    556572;(import pseudolists simple-tests)
    557 
     573;(ppp
     574;  (pl-iterate (No-sentinel) add1 5 0)
     575;  (pl-iterate (Some-sentinel #f) add1 5 0)
     576;  (pl-iterate (No-sentinel) add1 5)
     577;  (map (pl-iterate (No-sentinel) add1 5) '(0 1 2 3))
     578;  (pl-map (No-sentinel) add1 '(0 1 2 3 . #f))
     579;  (map (pl-map (No-sentinel) add1) '((0 1 2) (10 20 30)))
     580;  ;(pl-for ((x '(0 1 2 3 . #f))) (Some-sentinel #t) (add1 x)) ; map
     581;  (pl-for (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f)))
     582;  ;(pl-for ((x '(0 1 2 3))) (No-sentinel) (add1 x)) ; map
     583;  (pl-for (No-sentinel) (add1 x) (x '(0 1 2 3)))
     584;  ;(pl-for ((x '(0 1 2)) (y '(10 20 30))) (No-sentinel) (+ x y))
     585;  (pl-for (No-sentinel) (+ x y) (x '(0 1 2)) (y '(10 20 30)))
     586;  (pl-flatten (Some-sentinel #t) '(0 (1 (2 . #f) . #f) . #f))
     587;  (pl-flatten (No-sentinel) '(0 (1 2) (3 4 . #f) 5 . #f))
     588;  (pl-append (No-sentinel) '(0 1 2 . #f))
     589;  (pl-append (Some-sentinel #t) '(0 1 . #f) '(2 . #f) '(3 . #f))
     590;  )
     591;
  • release/5/pseudolists/tags/1.0/trunk/tests/run.scm

    r37451 r37763  
    1111  ((pl-of? symbol?) '(a b . c))
    1212
    13   (equal? (pl-maker #f 1 2 3 4)
     13  (equal? (pl-maker (Some-sentinel #f) 1 2 3 4)
    1414          '(1 2 3 4 . #f))
    15   (equal? (pl-maker #f 0 1 2 3) '(0 1 2 3 . #f))
    16   (equal? (pl-maker '() 0 1 2 3) '(0 1 2 3))
    17   (equal? (pl-iterate #f 5 add1 0) '(0 1 2 3 4 . #f))
     15  (equal? (pl-maker (Some-sentinel #f) 0 1 2 3) '(0 1 2 3 . #f))
     16  (equal? (pl-maker (No-sentinel) 0 1 2 3) '(0 1 2 3))
     17  (equal? (pl-iterate (Some-sentinel #f) add1 5 0) '(0 1 2 3 4 . #f))
    1818
    1919  (not (pl-sentinel
    20          (pl-maker #f 1 2 3 4)))
     20         (pl-maker (Some-sentinel #f) 1 2 3 4)))
    2121  (= (pl-sentinel '(0 1 2 3 2 . 2)) 2)
    2222  (not (pl-sentinel '(0 1 2 3 . #f)))
     
    4545  (equal? (pl-take 2 '(0 1 2 3 . #f)) '(0 1 . #f))
    4646  (equal? (pl-take-while odd? '(1 3 2 4 . #f)) '(1 3 . #f))
    47   (not (pl-take-while negative? '(1 3 2 4 . #f)))
     47  (null? (pl-take-while negative? '(1 3 2 4)))
    4848
    4949  (= (pl-filter odd? 1) 1)
    5050  (equal? (pl-filter odd? '(0 1 2 3 4)) '(1 3))
    5151  (equal? (pl-filter odd? '(0 1 2 3 . 4)) '(1 3 . 4))
     52  (equal? (pl-filter even? '(0 1 2 3 . 4)) '(0 2 . 4))
    5253 
    53   (equal? (pl-map add1 '(0 1 2 3 . 4)) '(1 2 3 4 . 4))
    54   (not (pl-map add1 #f))
     54  (equal? (pl-map (No-sentinel) add1 '(0 1 2 3 . 4)) '(1 2 3 4))
     55  (equal? (pl-map (Some-sentinel 5) add1 '(0 1 2 3 . 4)) '(1 2 3 4 . 5))
     56  (equal? (pl-map (Some-sentinel #f) add1 '(0 1 2 3)) '(1 2 3 4 . #f))
     57  (pl-map (Some-sentinel #t) add1 #f)
    5558
    56   (equal? (pl-reverse '(0 1 2 3 . 4)) '(3 2 1 0 . 4))
    57   (equal? (pl-reverse '(0 1 2 3)) '(3 2 1 0))
     59  (equal? (pl-reverse (Some-sentinel #f) '(0 1 2 3 . 4)) '(3 2 1 0 . #f))
     60  (equal? (pl-reverse (No-sentinel) '(0 1 2 3 . 4)) '(3 2 1 0))
     61  (equal? (pl-reverse (No-sentinel) '(0 1 2 3)) '(3 2 1 0))
     62  (equal? (pl-reverse (Some-sentinel #f) '(0 1 2 3)) '(3 2 1 0 . #f))
    5863
    59   (equal? (pl-append '(0 1) '(2 3) #f) '(0 1 2 3 . #f))
    60   (equal? (pl-append '(0 1 . #f) '(2 3)) '(0 1 2 3))
    61   (equal? (pl-append '(0 1) '(2 3) '(4 5)) '(0 1 2 3 4 5))
     64  (equal? (pl-append (No-sentinel) '(0 1) #f) '(0 1))
     65  (equal? (pl-append (Some-sentinel #f) '(0 1)) '(0 1 . #f))
     66  (equal? (pl-append (Some-sentinel #t) '(0 1) '(2 3) #f) '(0 1 2 3 . #t))
     67  (equal? (pl-append (No-sentinel)'(0 1 . #f) '(2 3)) '(0 1 2 3))
     68  (equal? (pl-append (No-sentinel)'(0 1) '(2 3) '(4 5)) '(0 1 2 3 4 5))
     69  (equal? (pl-append (No-sentinel)'(0 1 . #f) '(2 3 . #t) '(4 5)) '(0 1 2 3 4 5))
     70  (equal? (pl-append (Some-sentinel #f) '(0 1 . #t) '(2 3 . #t) '(4 5 . #t)) '(0 1 2 3 4 5 . #f))
     71  (equal? (pl-append (Some-sentinel #f) '(0 1 . #t) '(2 3 . #t) '(4 5) #t)
     72          '(0 1 2 3 4 5 .  #f))
    6273
    6374  (= (pl-fold-right + 0 '(1 2 3 . #f)) 6)
     
    7384  (equal? (pl-remove-dups '(0 1 2 1 3 2)) '(0 1 3 2))
    7485
    75   (equal? (pl-flatten '(0 1 . 2)) '(0 1 2))
    76   (equal? (pl-flatten '(0 (1 2))) '(0 1 2))
    77   (equal? (pl-flatten '(0 (1 (2 . 3)))) '(0 1 2 3))
    78   (equal? (pl-flatten '(0 (1 (2 . 3) 4))) '(0 1 2 3 4))
    79   (equal? (pl-flatten '(0 (1 (2 . 3) 4))) '(0 1 2 3 4))
    80   (equal? (pl-flatten '(0 (1 (2 . 3) 4 . #f))) '(0 1 2 3 4 #f))
     86  (equal? (pl-flatten (Some-sentinel #f) '(1 (2 3) . #t)) '(1 2 3 . #f))
     87  (equal? (pl-flatten (No-sentinel) '(1 (2 (3 . #f) . #t) . #f)) '(1 2 3))
     88  (pl-flatten (Some-sentinel #t) #f)
     89  (null? (pl-flatten (No-sentinel) #f))
    8190 
    82   (equal? (pl-for ((x '(0 1 2 3 . #f))) (add1 x)) ; map
    83     '(1 2 3 4 . #f))
    84   (equal? (pl-for ((x '(0 1 2 3))) (add1 x)) ; map
     91  (equal? (pl-for (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
     92    '(1 2 3 4 . #t))
     93  (equal? (pl-for (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
    8594    '(1 2 3 4))
    86   (equal? (pl-for ((x '(0 1 2 3 4 5 . #f) (odd? x))) x) ; filter
    87     '(1 3 5 . #f))
    88   (equal? (pl-for ((x '(0 1 2 3 4 5) (odd? x))) x) ; filter
     95  (equal? (pl-for (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
     96    '(1 3 5 . #t))
     97  (equal? (pl-for (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
    8998    '(1 3 5))
    90   (equal? (pl-for ((n '(0 1 2 3 4 5) (positive? n) (even? n)))
    91             (* 10 n))
     99  (equal? (pl-for (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    92100    '(20 40))
    93   (equal? (pl-for ((c '(A B C))
    94                    (k '(1 2 3 4)))
    95             (list c k))
     101  (equal? (pl-for (No-sentinel) (list c k)
     102                  (c '(A B C))
     103                  (k '(1 2 3 4)))
    96104    '((A 1) (A 2) (A 3) (A 4)
    97105      (B 1) (B 2) (B 3) (B 4)
    98106      (C 1) (C 2) (C 3) (C 4)))
    99   (equal? (pl-for ((c '(A B C . #f)) (k '(1 2 3 4 . #t))) (list c k))
     107  (equal? (pl-for (Some-sentinel #t) (list c k)
     108                  (c '(A B C . #f)) (k '(1 2 3 4 . #f)))
    100109    '((A 1) (A 2) (A 3) (A 4)
    101110      (B 1) (B 2) (B 3) (B 4)
    102       (C 1) (C 2) (C 3) (C 4) . #f))
     111      (C 1) (C 2) (C 3) (C 4) . #t))
    103112  )
    104113 
  • release/5/pseudolists/tags/1.2/pseudolists.egg

    r37750 r37763  
    66 (test-dependencies simple-tests)
    77 (author "Juergen Lorenz")
    8  (version "1.1")
     8 (version "1.2")
    99 (components (extension pseudolists)))
    1010
  • release/5/pseudolists/tags/1.2/pseudolists.scm

    r37750 r37763  
    4343   pl-fold-right pl-fold-left
    4444   pl-fold-right0 pl-fold-left0
    45    pl-for pseudolists
     45   pl-collect pseudolists
    4646   Some-sentinel No-sentinel sentinel ;sentinel-option sentinel-option?
    4747   )
     
    362362      result)))
    363363
    364 ;;; (pl-for ((var pl ok-xpr ...) ....) opt item-xpr)
     364;;; (pl-collect ((var pl ok-xpr ...) ....) opt item-xpr)
    365365;;; ------------------------------------------------
    366 (define-syntax pl-for
     366(define-syntax pl-collect
    367367  (syntax-rules ()
    368368   ;((_ ((var pl ok-xpr ...)) opt item-xpr)
     
    382382        (let ((var (car seq)))
    383383          (if (and ok-xpr ...)
    384             (pl-append opt ;(pl-for ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
    385                        (pl-for opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
     384            (pl-append opt ;(pl-collect ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
     385                       (pl-collect opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
    386386                       (recur (cdr seq)))
    387387            (recur (cdr seq)))))))
     
    422422      (pl-iterate opt fn k)
    423423      (pl-iterate opt fn k init)
    424       "creates a pseudolist with (sentinel opt) applying fn to int"
     424      "creates a pseudolist with (sentinel opt) applying fn to init"
    425425      "recursively k times")
    426426    (pl-length
     
    548548        "flattens the nested pseudolist tree to a"
    549549        "pseudolist with (sentinel opt)")
    550     (pl-for
     550    (pl-collect
    551551      macro:
    552       (pl-for opt xpr (var pl ok-xpr ...) ....)
     552      (pl-collect opt xpr (var pl ok-xpr ...) ....)
    553553      "creates a new pseudolist with (sentinel opt) by binding var to each element"
    554554      "of the pseudolist pl in sequence, and if it passes the checks,"
     
    578578;  (pl-map (No-sentinel) add1 '(0 1 2 3 . #f))
    579579;  (map (pl-map (No-sentinel) add1) '((0 1 2) (10 20 30)))
    580 ;  ;(pl-for ((x '(0 1 2 3 . #f))) (Some-sentinel #t) (add1 x)) ; map
    581 ;  (pl-for (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f)))
    582 ;  ;(pl-for ((x '(0 1 2 3))) (No-sentinel) (add1 x)) ; map
    583 ;  (pl-for (No-sentinel) (add1 x) (x '(0 1 2 3)))
    584 ;  ;(pl-for ((x '(0 1 2)) (y '(10 20 30))) (No-sentinel) (+ x y))
    585 ;  (pl-for (No-sentinel) (+ x y) (x '(0 1 2)) (y '(10 20 30)))
     580;  ;(pl-collect ((x '(0 1 2 3 . #f))) (Some-sentinel #t) (add1 x)) ; map
     581;  (pl-collect (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f)))
     582;  ;(pl-collect ((x '(0 1 2 3))) (No-sentinel) (add1 x)) ; map
     583;  (pl-collect (No-sentinel) (add1 x) (x '(0 1 2 3)))
     584;  ;(pl-collect ((x '(0 1 2)) (y '(10 20 30))) (No-sentinel) (+ x y))
     585;  (pl-collect (No-sentinel) (+ x y) (x '(0 1 2)) (y '(10 20 30)))
    586586;  (pl-flatten (Some-sentinel #t) '(0 (1 (2 . #f) . #f) . #f))
    587587;  (pl-flatten (No-sentinel) '(0 (1 2) (3 4 . #f) 5 . #f))
  • release/5/pseudolists/tags/1.2/tests/run.scm

    r37750 r37763  
    8989  (null? (pl-flatten (No-sentinel) #f))
    9090 
    91   (equal? (pl-for (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
     91  (equal? (pl-collect (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
    9292    '(1 2 3 4 . #t))
    93   (equal? (pl-for (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
     93  (equal? (pl-collect (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
    9494    '(1 2 3 4))
    95   (equal? (pl-for (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
     95  (equal? (pl-collect (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
    9696    '(1 3 5 . #t))
    97   (equal? (pl-for (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
     97  (equal? (pl-collect (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
    9898    '(1 3 5))
    99   (equal? (pl-for (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
     99  (equal? (pl-collect (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    100100    '(20 40))
    101   (equal? (pl-for (No-sentinel) (list c k)
     101  (equal? (pl-collect (No-sentinel) (list c k)
    102102                  (c '(A B C))
    103103                  (k '(1 2 3 4)))
     
    105105      (B 1) (B 2) (B 3) (B 4)
    106106      (C 1) (C 2) (C 3) (C 4)))
    107   (equal? (pl-for (Some-sentinel #t) (list c k)
     107  (equal? (pl-collect (Some-sentinel #t) (list c k)
    108108                  (c '(A B C . #f)) (k '(1 2 3 4 . #f)))
    109109    '((A 1) (A 2) (A 3) (A 4)
  • release/5/pseudolists/trunk/pseudolists.egg

    r37750 r37763  
    66 (test-dependencies simple-tests)
    77 (author "Juergen Lorenz")
    8  (version "1.1")
     8 (version "1.2")
    99 (components (extension pseudolists)))
    1010
  • release/5/pseudolists/trunk/pseudolists.scm

    r37750 r37763  
    4343   pl-fold-right pl-fold-left
    4444   pl-fold-right0 pl-fold-left0
    45    pl-for pseudolists
     45   pl-collect pseudolists
    4646   Some-sentinel No-sentinel sentinel ;sentinel-option sentinel-option?
    4747   )
     
    362362      result)))
    363363
    364 ;;; (pl-for ((var pl ok-xpr ...) ....) opt item-xpr)
     364;;; (pl-collect ((var pl ok-xpr ...) ....) opt item-xpr)
    365365;;; ------------------------------------------------
    366 (define-syntax pl-for
     366(define-syntax pl-collect
    367367  (syntax-rules ()
    368368   ;((_ ((var pl ok-xpr ...)) opt item-xpr)
     
    382382        (let ((var (car seq)))
    383383          (if (and ok-xpr ...)
    384             (pl-append opt ;(pl-for ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
    385                        (pl-for opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
     384            (pl-append opt ;(pl-collect ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
     385                       (pl-collect opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
    386386                       (recur (cdr seq)))
    387387            (recur (cdr seq)))))))
     
    422422      (pl-iterate opt fn k)
    423423      (pl-iterate opt fn k init)
    424       "creates a pseudolist with (sentinel opt) applying fn to int"
     424      "creates a pseudolist with (sentinel opt) applying fn to init"
    425425      "recursively k times")
    426426    (pl-length
     
    548548        "flattens the nested pseudolist tree to a"
    549549        "pseudolist with (sentinel opt)")
    550     (pl-for
     550    (pl-collect
    551551      macro:
    552       (pl-for opt xpr (var pl ok-xpr ...) ....)
     552      (pl-collect opt xpr (var pl ok-xpr ...) ....)
    553553      "creates a new pseudolist with (sentinel opt) by binding var to each element"
    554554      "of the pseudolist pl in sequence, and if it passes the checks,"
     
    578578;  (pl-map (No-sentinel) add1 '(0 1 2 3 . #f))
    579579;  (map (pl-map (No-sentinel) add1) '((0 1 2) (10 20 30)))
    580 ;  ;(pl-for ((x '(0 1 2 3 . #f))) (Some-sentinel #t) (add1 x)) ; map
    581 ;  (pl-for (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f)))
    582 ;  ;(pl-for ((x '(0 1 2 3))) (No-sentinel) (add1 x)) ; map
    583 ;  (pl-for (No-sentinel) (add1 x) (x '(0 1 2 3)))
    584 ;  ;(pl-for ((x '(0 1 2)) (y '(10 20 30))) (No-sentinel) (+ x y))
    585 ;  (pl-for (No-sentinel) (+ x y) (x '(0 1 2)) (y '(10 20 30)))
     580;  ;(pl-collect ((x '(0 1 2 3 . #f))) (Some-sentinel #t) (add1 x)) ; map
     581;  (pl-collect (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f)))
     582;  ;(pl-collect ((x '(0 1 2 3))) (No-sentinel) (add1 x)) ; map
     583;  (pl-collect (No-sentinel) (add1 x) (x '(0 1 2 3)))
     584;  ;(pl-collect ((x '(0 1 2)) (y '(10 20 30))) (No-sentinel) (+ x y))
     585;  (pl-collect (No-sentinel) (+ x y) (x '(0 1 2)) (y '(10 20 30)))
    586586;  (pl-flatten (Some-sentinel #t) '(0 (1 (2 . #f) . #f) . #f))
    587587;  (pl-flatten (No-sentinel) '(0 (1 2) (3 4 . #f) 5 . #f))
  • release/5/pseudolists/trunk/tests/run.scm

    r37750 r37763  
    8989  (null? (pl-flatten (No-sentinel) #f))
    9090 
    91   (equal? (pl-for (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
     91  (equal? (pl-collect (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
    9292    '(1 2 3 4 . #t))
    93   (equal? (pl-for (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
     93  (equal? (pl-collect (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
    9494    '(1 2 3 4))
    95   (equal? (pl-for (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
     95  (equal? (pl-collect (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
    9696    '(1 3 5 . #t))
    97   (equal? (pl-for (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
     97  (equal? (pl-collect (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
    9898    '(1 3 5))
    99   (equal? (pl-for (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
     99  (equal? (pl-collect (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    100100    '(20 40))
    101   (equal? (pl-for (No-sentinel) (list c k)
     101  (equal? (pl-collect (No-sentinel) (list c k)
    102102                  (c '(A B C))
    103103                  (k '(1 2 3 4)))
     
    105105      (B 1) (B 2) (B 3) (B 4)
    106106      (C 1) (C 2) (C 3) (C 4)))
    107   (equal? (pl-for (Some-sentinel #t) (list c k)
     107  (equal? (pl-collect (Some-sentinel #t) (list c k)
    108108                  (c '(A B C . #f)) (k '(1 2 3 4 . #f)))
    109109    '((A 1) (A 2) (A 3) (A 4)
Note: See TracChangeset for help on using the changeset viewer.