Changeset 37770 in project


Ignore:
Timestamp:
07/08/19 12:44:33 (9 days ago)
Author:
juergen
Message:

pseudolists-1.3 without sentinel-options

Location:
release/5/pseudolists
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/pseudolists/tags/1.3/pseudolists.egg

    r37763 r37770  
    33 (category lang-exts)
    44 (license "BSD")
    5  (dependencies datatype)
    65 (test-dependencies simple-tests)
    76 (author "Juergen Lorenz")
    8  (version "1.2")
     7 (version "1.3")
    98 (components (extension pseudolists)))
    109
  • release/5/pseudolists/tags/1.3/pseudolists.scm

    r37763 r37770  
    3333
    3434(module pseudolists
    35   (pl-maker pl-iterate pl? pl-of?
     35  (pl-iterate pl? pl-of?
    3636   pl-null? pl-length pl-head pl-sentinel
    3737   pl-flatten pl-reverse
     
    4343   pl-fold-right pl-fold-left
    4444   pl-fold-right0 pl-fold-left0
    45    pl-collect pseudolists
    46    Some-sentinel No-sentinel sentinel ;sentinel-option sentinel-option?
     45   pl-collect
     46   pseudolists
    4747   )
    4848
    4949  (import scheme
    50           datatype
    5150          (only (chicken base) cut case-lambda assert print error))
    5251
    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)
    65   (let loop ((args args))
    66     (if (null? args)
    67       (sentinel opt)
    68       (cons (car args) (loop (cdr args))))))
    69 
    70 (define (pl-iterate opt fn times . inits)
    71   (cond
    72     ((null? inits)
    73      (lambda (x)
    74        (pl-iterate opt fn times x)))
    75     ((null? (cdr inits))
    76      (let recur ((x (car inits)) (k 0))
     52
     53(define pl-iterate
     54  (case-lambda
     55    ((fn times)
     56     (lambda (init)
     57       (pl-iterate fn times init)))
     58    ((fn times init)
     59     (let recur ((x init) (k 0))
    7760       (if (= k times)
    78          (sentinel opt)
     61         '()
    7962         (cons x (recur (fn x) (+ k 1))))))
    80     (else 'pl-iterate "too many arguments")))
     63    ))
    8164
    8265(define (pl? xpr)
     
    146129       (assert (or (pl-null? pl) (< -1 n (pl-length pl))))
    147130       (let loop ((n n) (pl pl))
     131         (print "PPP " pl)
    148132         (cond
    149            ((pl-null? pl) pl)
    150            ((zero? n) pl)
     133           ((pl-null? pl) (pl-head pl))
     134           ((zero? n) (pl-head pl))
    151135           (else
    152136             (loop (- n 1) (cdr pl)))))))
     
    161145     (let loop ((pl pl))
    162146       (if (pl-null? pl)
    163          pl
     147         '()
    164148         (let ((first (car pl)) (rest (cdr pl)))
    165149           (if (ok? first)
    166150             (loop rest)
    167              pl)))))
     151             (pl-head pl))))))
    168152    ))
    169153
     
    178162       (cond
    179163         ((pl-null? pl)
    180           pl)
     164          '())
    181165         ((< k n)
    182166          (cons (car pl) (recur (+ k 1) (cdr pl))))
     
    192176     (let recur ((pl pl))
    193177       (if (pl-null? pl)
    194          pl
     178         '()
    195179         (let ((first (car pl)) (rest (cdr pl)))
    196180           (if (ok? first)
     
    199183    ))
    200184
    201 (define (pl-reverse opt pl)
    202   (let loop ((pl pl) (result (sentinel opt)))
     185(define (pl-reverse pl)
     186  (let loop ((pl pl) (result '()))
    203187    (if (pl-null? pl)
    204188      result
     
    207191(define pl-map
    208192  (case-lambda
    209     ((opt fn)
    210      (lambda (pl)
    211        (pl-map opt fn pl)))
    212     ((opt fn pl)
     193    ((fn)
     194     (lambda (pl)
     195       (pl-map fn pl)))
     196    ((fn pl)
    213197     (let recur ((pl pl))
    214198       (if (pl-null? pl)
    215          (sentinel opt)
     199         '()
    216200         (cons (fn (car pl)) (recur (cdr pl))))))
    217201    ))
    218202
    219 (define (pl-memp ok? . pls)
    220   (cond
    221     ((null? pls)
     203(define pl-memp
     204  (case-lambda
     205    ((ok?)
    222206     (lambda (pl)
    223207       (pl-memp ok? pl)))
    224     ((null? (cdr pls))
    225      (let recur ((pl (car pls)))
    226        (if (pl-null? pl)
    227          pl
    228          (let ((first (car pl)) (rest (cdr pl)))
    229            (if (ok? first)
    230              (cons first rest)
    231              (recur rest))))))
    232     (else (error 'pl-memp "too many arguments"))))
     208    ((ok? pl)
     209     (let ((result
     210             (let recur ((pl pl))
     211               (if (pl-null? pl)
     212                 '()
     213                 (let ((first (car pl))
     214                       (rest (cdr pl)))
     215                   (if (ok? first)
     216                     (cons first rest)
     217                     (recur rest)))))))
     218       (if (null? result) #f (pl-head result))))
     219    ))
    233220
    234221(define (pl-memq x . pls)
     
    263250     (let recur ((pl pl))
    264251       (if (pl-null? pl)
    265          pl
     252         '()
    266253         (let ((first (car pl)) (rest (cdr pl)))
    267254           (if (ok? first)
     
    270257    ))
    271258
    272 (define (pl-append opt pl . pls)
    273   (cond
    274     ((null? pls); pl)
    275      (let recur ((pl pl))
    276        (if (pl-null? pl)
    277          (sentinel opt)
     259(define pl-append
     260  (case-lambda
     261    ((pl) pl)
     262    ((pl0 pl1)
     263     (let recur ((pl pl0))
     264       (if (pl-null? pl)
     265         (pl-head pl1)
    278266         (cons (car pl) (recur (cdr pl))))))
    279     ((null? (cdr pls))
    280      (let recur ((pl pl))
    281        (if (pl-null? pl)
    282          (pl-append opt (car pls))
    283          (cons (car pl) (recur (cdr pl))))))
    284     (else
    285       (pl-append opt pl (apply pl-append opt (car pls) (cdr pls))))))
     267    ((pl0 pl1 . pls)
     268     (pl-append pl0 (apply pl-append pl1 pls)))
     269    ))
    286270
    287271(define pl-fold-right
     
    341325     (let ((pl pl))
    342326       (if (pair? (pl-member obj pl))
    343          pl
    344          (cons obj pl))))
     327         (pl-head pl)
     328         (pl-head (cons obj pl)))))
    345329    ))
    346330
     
    348332  (let recur ((pl pl))
    349333    (if (pl-null? pl)
    350       pl
     334      '()
    351335      (pl-adjoin (car pl) (recur (cdr pl))))))
    352336
    353 (define (pl-flatten opt pl-tree)
    354   (let recur ((tree pl-tree) (result (sentinel opt)))
     337(define (pl-flatten pl-tree)
     338  (let recur ((tree pl-tree) (result '()))
    355339    (if (pair? tree)
    356340      (let ((head (car tree)) (tail (cdr tree)))
     
    362346      result)))
    363347
    364 ;;; (pl-collect ((var pl ok-xpr ...) ....) opt item-xpr)
    365 ;;; ------------------------------------------------
    366348(define-syntax pl-collect
    367349  (syntax-rules ()
    368    ;((_ ((var pl ok-xpr ...)) opt item-xpr)
    369    ((_ opt item-xpr (var pl ok-xpr ...))
     350   ((_ item-xpr (var pl ok-xpr ...))
    370351     (let recur ((seq pl))
    371352       (if (pl-null? seq)
    372          (sentinel opt)
     353         '()
    373354         (let ((var (car seq)))
    374355           (if (and ok-xpr ...)
    375356             (cons item-xpr (recur (cdr seq)))
    376357             (recur (cdr seq)))))))
    377    ;((_ ((var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
    378    ((_ opt item-xpr (var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...)
     358   ((_ item-xpr (var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...)
    379359    (let recur ((seq pl))
    380360      (if (pl-null? seq)
    381         (sentinel opt)
     361        '()
    382362        (let ((var (car seq)))
    383363          (if (and ok-xpr ...)
    384             (pl-append opt ;(pl-collect ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
    385                        (pl-collect opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
     364            (pl-append (pl-collect item-xpr (var1 pl1 ok-xpr1 ...) ...)
    386365                       (recur (cdr seq)))
    387366            (recur (cdr seq)))))))
    388367   ))
     368
    389369
    390370;;; (pseudolists sym ..)
     
    400380      "the first call returns all exported symbols,"
    401381      "the second documentation of symbol sym")
    402     (pl-maker
    403       procedure:
    404         (pl-maker opt . args)
    405         "creates a new pseudolist with (sentinel opt) from args")
    406382    (pl?
    407383      procedure:
     
    417393      procedure:
    418394        (pl-null? xpr)
    419         "is xpr pl-null?, i.e. not a pair")
     395        "is xpr an atom, i.e. not a pair?")
    420396    (pl-iterate
    421397      procedure:
    422       (pl-iterate opt fn k)
    423       (pl-iterate opt fn k init)
    424       "creates a pseudolist with (sentinel opt) applying fn to init"
     398      (pl-iterate fn k)
     399      (pl-iterate fn k init)
     400      "creates a list applying fn to init"
    425401      "recursively k times")
    426402    (pl-length
     
    468444    (pl-map
    469445      procedure:
    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)")
     446        (pl-map fn)
     447        (pl-map fn pl)
     448        "maps fn over the pseudolist pl and returns a new list")
    474449    (pl-index
    475450      procedure:
     
    485460    (pl-reverse
    486461      procedure:
    487       (pl-reverse opt pl)
    488       "reverses its pseudolist argument to a now one"
    489       "with (sentinel opt)")
     462      (pl-reverse pl)
     463      "reverses its pseudolist argument to a new list")
    490464    (pl-append
    491465      procedure:
    492       (pl-append opt pl . pls)
    493       "appends all argument pseudolists to a pseudolist"
    494       "with (sentinel opt)")
     466      (pl-append pl . pls)
     467      "appends all argument pseudolists to a list")
    495468    (pl-memp
    496469      procedure:
     470      (pl-memp ok?)
    497471      (pl-memp ok? pl)
    498       "returns the sub-pseudolist starting at the first"
    499       "item which passes the ok? test")
     472      "returns the sublist starting at the first"
     473      "item which passes the ok? test,"
     474      "returns #f if now item passes the ok? test")
    500475    (pl-member
    501476      procedure:
     477      (pl-member x)
    502478      (pl-member x pl)
    503479      "same as (pl-memp (cut equal? <> x) pl)")
    504480    (pl-memq
    505481      procedure:
     482      (pl-memq x)
    506483      (pl-memq x pl)
    507484      "same as (pl-memp (cut eq? <> x) pl)")
    508485    (pl-memv
    509486      procedure:
     487      (pl-memv x)
    510488      (pl-memv x pl)
    511489      "same as (pl-memp (cut eqv? <> x) pl)")
     
    538516        (pl-adjoin obj)
    539517        (pl-adjoin obj pl)
    540         "adds obj to a pseudolist, provided, it isn't already there")
     518        "adds obj to a pseudolist stripping the sentinel,"
     519        "provided, it isn't already there")
    541520    (pl-remove-dups
    542521      procedure:
    543522        (pl-remove-dups lst)
    544         "removes duplicates of a pseudolist")
     523        "removes duplicates of a pseudolist stripping the sentinel")
    545524    (pl-flatten
    546525      procedure:
    547         (pl-flatten opt pl-tree)
    548         "flattens the nested pseudolist tree to a"
    549         "pseudolist with (sentinel opt)")
     526        (pl-flatten pl-tree)
     527        "flattens the nested pseudolist tree to a list")
    550528    (pl-collect
    551529      macro:
    552       (pl-collect opt xpr (var pl ok-xpr ...) ....)
    553       "creates a new pseudolist with (sentinel opt) by binding var to each element"
     530      (pl-collect xpr (var pl ok-xpr ...) ....)
     531      "creates a new list by binding var to each element"
    554532      "of the pseudolist pl in sequence, and if it passes the checks,"
    555       "ok-xpr ..., inserts the value of xpr into the resulting pseudolist."
     533      "ok-xpr ..., inserts the value of xpr into the resulting list."
    556534      "The qualifieres, (var pl ok-xpr ...), are processed"
    557535      "sequentially from left to right, so that filters of a"
     
    571549
    572550;(import pseudolists simple-tests)
    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-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)))
    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 ;
     551 
  • release/5/pseudolists/tags/1.3/tests/run.scm

    r37763 r37770  
    1111  ((pl-of? symbol?) '(a b . c))
    1212
    13   (equal? (pl-maker (Some-sentinel #f) 1 2 3 4)
    14           '(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))
     13  (equal? (pl-iterate add1 5 0) '(0 1 2 3 4))
    1814
    19   (not (pl-sentinel
    20          (pl-maker (Some-sentinel #f) 1 2 3 4)))
     15  (not (pl-sentinel '(1 2 3 4 . #f)))
    2116  (= (pl-sentinel '(0 1 2 3 2 . 2)) 2)
    22   (not (pl-sentinel '(0 1 2 3 . #f)))
     17 
    2318  (= (pl-length '(0 1 2 3 . 4)) 4)
    2419
     
    3631
    3732  (equal? (pl-drop 1 '(0 1 2 3 . 4))
    38           '(1 2 3 . 4))
    39   (= (pl-drop 0 1) 1)
    40   (equal? (pl-drop 2 '(0 1 2 3 . #f)) '(2 3 . #f))
    41   (equal? (pl-drop-while odd? '(1 3 2 4 . #f)) '(2 4 . #f))
    42   (equal? (pl-drop-while negative? '(1 3 2 4 . #f)) '(1 3 2 4 . #f))
     33          '(1 2 3))
     34  (null? (pl-drop 0 1))
     35  (equal? (pl-drop 2 '(0 1 2 3 . #f)) '(2 3))
     36  (equal? (pl-drop-while odd? '(1 3 2 4 . #f)) '(2 4))
     37  (equal? (pl-drop-while negative? '(1 3 2 4 . #f)) '(1 3 2 4))
    4338 
    44   (equal? (pl-take 3 '(0 1 2 3 4 . #t)) '(0 1 2 . #t))
    45   (equal? (pl-take 2 '(0 1 2 3 . #f)) '(0 1 . #f))
    46   (equal? (pl-take-while odd? '(1 3 2 4 . #f)) '(1 3 . #f))
     39  (equal? (pl-take 3 '(0 1 2 3 4 . #t)) '(0 1 2))
     40  (equal? (pl-take 2 '(0 1 2 3 . #f)) '(0 1))
     41  (equal? (pl-take-while odd? '(1 3 2 4 . #f)) '(1 3))
    4742  (null? (pl-take-while negative? '(1 3 2 4)))
    4843
    49   (= (pl-filter odd? 1) 1)
     44  (null? (pl-filter odd? 1))
    5045  (equal? (pl-filter odd? '(0 1 2 3 4)) '(1 3))
    51   (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))
     46  (equal? (pl-filter odd? '(0 1 2 3 . 4)) '(1 3))
     47  (equal? (pl-filter even? '(0 1 2 3 . 4)) '(0 2))
    5348 
    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)
     49  (equal? (pl-map add1 '(0 1 2 3 . 4)) '(1 2 3 4))
     50  (equal? (pl-map add1 '(0 1 2 3 . 4)) '(1 2 3 4))
     51  (equal? (pl-map add1 '(0 1 2 3)) '(1 2 3 4))
     52  (null? (pl-map add1 #f))
    5853
    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))
     54  (not (pl-memp odd? '(0 2 4 . #t)))
     55  (not (pl-memv 5 '(0 1 2 3 4 . 5)))
     56  (equal? (pl-member 3 '(0 1 2 3 4 . 5)) '(3 4))
    6357
    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))
     58  (equal? (pl-reverse '(0 1 2 3 . 4)) '(3 2 1 0))
     59  (equal? (pl-reverse '(0 1 2 3 . 4)) '(3 2 1 0))
     60  (equal? (pl-reverse '(0 1 2 3)) '(3 2 1 0))
     61
     62  (equal? (pl-append '(0 1) #f) '(0 1))
     63  (equal? (pl-append '(0 1)) '(0 1))
     64  (equal? (pl-append '(0 1) '(2 3) #f) '(0 1 2 3))
     65  (equal? (pl-append '(0 1 . #f) '(2 3)) '(0 1 2 3))
     66  (equal? (pl-append '(0 1) '(2 3) '(4 5)) '(0 1 2 3 4 5))
     67  (equal? (pl-append '(0 1 . #f) '(2 3 . #t) '(4 5)) '(0 1 2 3 4 5))
     68  (equal? (pl-append '(0 1 . #t) '(2 3 . #t) '(4 5 . #t)) '(0 1 2 3 4 5))
     69  (equal? (pl-append '(0 1 . #t) '(2 3 . #t) '(4 5) #t)
     70          '(0 1 2 3 4 5))
    7371
    7472  (= (pl-fold-right + 0 '(1 2 3 . #f)) 6)
    7573  (= (pl-fold-left + 0 '(1 2 3)) 6)
    7674
    77   (equal? (pl-adjoin 2 '(0 1 2 3 . #f)) '(0 1 2 3 . #f))
    78   (equal? (pl-adjoin 4 '(0 1 2 3 #f)) '(4 0 1 2 3 #f))
     75  (equal? (pl-adjoin 2 '(0 1 2 3 . #f)) '(0 1 2 3))
     76  (equal? (pl-adjoin 4 '(0 1 2 3 #f . #t)) '(4 0 1 2 3 #f))
    7977  (equal? (pl-adjoin 1 '(0 1 2 3)) '(0 1 2 3))
    80   (equal? (pl-adjoin 1 '()) '(1))
     78  (equal? (pl-adjoin 1 #f) '(1))
    8179
    82   (equal? (pl-remove-dups '(0 1 2 3 2 . 2)) '(0 1 3 2 . 2))
     80  (equal? (pl-remove-dups '(0 1 2 3 2 . 2)) '(0 1 3 2))
    8381  (equal? (pl-remove-dups '(0 1 2 3 2 2)) '(0 1 3 2))
    8482  (equal? (pl-remove-dups '(0 1 2 1 3 2)) '(0 1 3 2))
    8583
    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))
     84  (equal? (pl-flatten '(1 (2 3) . #t)) '(1 2 3))
     85  (equal? (pl-flatten '(1 (2 (3 . #f) . #t) . #f)) '(1 2 3))
     86  (null? (pl-flatten #f))
    9087 
    91   (equal? (pl-collect (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
    92     '(1 2 3 4 . #t))
    93   (equal? (pl-collect (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
     88  (equal? (pl-collect (add1 x) (x '(0 1 2 3 . #f))) ; map
    9489    '(1 2 3 4))
    95   (equal? (pl-collect (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
    96     '(1 3 5 . #t))
    97   (equal? (pl-collect (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
     90  (equal? (pl-collect (add1 x) (x '(0 1 2 3))) ; map
     91    '(1 2 3 4))
     92  (equal? (pl-collect x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
    9893    '(1 3 5))
    99   (equal? (pl-collect (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
     94  (equal? (pl-collect x (x '(0 1 2 3 4 5) (odd? x))) ; filter
     95    '(1 3 5))
     96  (equal? (pl-collect (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    10097    '(20 40))
    101   (equal? (pl-collect (No-sentinel) (list c k)
    102                   (c '(A B C))
    103                   (k '(1 2 3 4)))
     98  (equal? (pl-collect (list c k)
     99                      (c '(A B C))
     100                      (k '(1 2 3 4)))
    104101    '((A 1) (A 2) (A 3) (A 4)
    105102      (B 1) (B 2) (B 3) (B 4)
    106103      (C 1) (C 2) (C 3) (C 4)))
    107   (equal? (pl-collect (Some-sentinel #t) (list c k)
    108                   (c '(A B C . #f)) (k '(1 2 3 4 . #f)))
     104  (equal? (pl-collect (list c k)
     105                      (c '(A B C . #f))
     106                      (k '(1 2 3 4 . #f)))
    109107    '((A 1) (A 2) (A 3) (A 4)
    110108      (B 1) (B 2) (B 3) (B 4)
    111       (C 1) (C 2) (C 3) (C 4) . #t))
     109      (C 1) (C 2) (C 3) (C 4)))
    112110  )
    113111 
  • release/5/pseudolists/trunk/pseudolists.egg

    r37763 r37770  
    33 (category lang-exts)
    44 (license "BSD")
    5  (dependencies datatype)
    65 (test-dependencies simple-tests)
    76 (author "Juergen Lorenz")
    8  (version "1.2")
     7 (version "1.3")
    98 (components (extension pseudolists)))
    109
  • release/5/pseudolists/trunk/pseudolists.scm

    r37763 r37770  
    3333
    3434(module pseudolists
    35   (pl-maker pl-iterate pl? pl-of?
     35  (pl-iterate pl? pl-of?
    3636   pl-null? pl-length pl-head pl-sentinel
    3737   pl-flatten pl-reverse
     
    4343   pl-fold-right pl-fold-left
    4444   pl-fold-right0 pl-fold-left0
    45    pl-collect pseudolists
    46    Some-sentinel No-sentinel sentinel ;sentinel-option sentinel-option?
     45   pl-collect
     46   pseudolists
    4747   )
    4848
    4949  (import scheme
    50           datatype
    5150          (only (chicken base) cut case-lambda assert print error))
    5251
    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)
    65   (let loop ((args args))
    66     (if (null? args)
    67       (sentinel opt)
    68       (cons (car args) (loop (cdr args))))))
    69 
    70 (define (pl-iterate opt fn times . inits)
    71   (cond
    72     ((null? inits)
    73      (lambda (x)
    74        (pl-iterate opt fn times x)))
    75     ((null? (cdr inits))
    76      (let recur ((x (car inits)) (k 0))
     52
     53(define pl-iterate
     54  (case-lambda
     55    ((fn times)
     56     (lambda (init)
     57       (pl-iterate fn times init)))
     58    ((fn times init)
     59     (let recur ((x init) (k 0))
    7760       (if (= k times)
    78          (sentinel opt)
     61         '()
    7962         (cons x (recur (fn x) (+ k 1))))))
    80     (else 'pl-iterate "too many arguments")))
     63    ))
    8164
    8265(define (pl? xpr)
     
    146129       (assert (or (pl-null? pl) (< -1 n (pl-length pl))))
    147130       (let loop ((n n) (pl pl))
     131         (print "PPP " pl)
    148132         (cond
    149            ((pl-null? pl) pl)
    150            ((zero? n) pl)
     133           ((pl-null? pl) (pl-head pl))
     134           ((zero? n) (pl-head pl))
    151135           (else
    152136             (loop (- n 1) (cdr pl)))))))
     
    161145     (let loop ((pl pl))
    162146       (if (pl-null? pl)
    163          pl
     147         '()
    164148         (let ((first (car pl)) (rest (cdr pl)))
    165149           (if (ok? first)
    166150             (loop rest)
    167              pl)))))
     151             (pl-head pl))))))
    168152    ))
    169153
     
    178162       (cond
    179163         ((pl-null? pl)
    180           pl)
     164          '())
    181165         ((< k n)
    182166          (cons (car pl) (recur (+ k 1) (cdr pl))))
     
    192176     (let recur ((pl pl))
    193177       (if (pl-null? pl)
    194          pl
     178         '()
    195179         (let ((first (car pl)) (rest (cdr pl)))
    196180           (if (ok? first)
     
    199183    ))
    200184
    201 (define (pl-reverse opt pl)
    202   (let loop ((pl pl) (result (sentinel opt)))
     185(define (pl-reverse pl)
     186  (let loop ((pl pl) (result '()))
    203187    (if (pl-null? pl)
    204188      result
     
    207191(define pl-map
    208192  (case-lambda
    209     ((opt fn)
    210      (lambda (pl)
    211        (pl-map opt fn pl)))
    212     ((opt fn pl)
     193    ((fn)
     194     (lambda (pl)
     195       (pl-map fn pl)))
     196    ((fn pl)
    213197     (let recur ((pl pl))
    214198       (if (pl-null? pl)
    215          (sentinel opt)
     199         '()
    216200         (cons (fn (car pl)) (recur (cdr pl))))))
    217201    ))
    218202
    219 (define (pl-memp ok? . pls)
    220   (cond
    221     ((null? pls)
     203(define pl-memp
     204  (case-lambda
     205    ((ok?)
    222206     (lambda (pl)
    223207       (pl-memp ok? pl)))
    224     ((null? (cdr pls))
    225      (let recur ((pl (car pls)))
    226        (if (pl-null? pl)
    227          pl
    228          (let ((first (car pl)) (rest (cdr pl)))
    229            (if (ok? first)
    230              (cons first rest)
    231              (recur rest))))))
    232     (else (error 'pl-memp "too many arguments"))))
     208    ((ok? pl)
     209     (let ((result
     210             (let recur ((pl pl))
     211               (if (pl-null? pl)
     212                 '()
     213                 (let ((first (car pl))
     214                       (rest (cdr pl)))
     215                   (if (ok? first)
     216                     (cons first rest)
     217                     (recur rest)))))))
     218       (if (null? result) #f (pl-head result))))
     219    ))
    233220
    234221(define (pl-memq x . pls)
     
    263250     (let recur ((pl pl))
    264251       (if (pl-null? pl)
    265          pl
     252         '()
    266253         (let ((first (car pl)) (rest (cdr pl)))
    267254           (if (ok? first)
     
    270257    ))
    271258
    272 (define (pl-append opt pl . pls)
    273   (cond
    274     ((null? pls); pl)
    275      (let recur ((pl pl))
    276        (if (pl-null? pl)
    277          (sentinel opt)
     259(define pl-append
     260  (case-lambda
     261    ((pl) pl)
     262    ((pl0 pl1)
     263     (let recur ((pl pl0))
     264       (if (pl-null? pl)
     265         (pl-head pl1)
    278266         (cons (car pl) (recur (cdr pl))))))
    279     ((null? (cdr pls))
    280      (let recur ((pl pl))
    281        (if (pl-null? pl)
    282          (pl-append opt (car pls))
    283          (cons (car pl) (recur (cdr pl))))))
    284     (else
    285       (pl-append opt pl (apply pl-append opt (car pls) (cdr pls))))))
     267    ((pl0 pl1 . pls)
     268     (pl-append pl0 (apply pl-append pl1 pls)))
     269    ))
    286270
    287271(define pl-fold-right
     
    341325     (let ((pl pl))
    342326       (if (pair? (pl-member obj pl))
    343          pl
    344          (cons obj pl))))
     327         (pl-head pl)
     328         (pl-head (cons obj pl)))))
    345329    ))
    346330
     
    348332  (let recur ((pl pl))
    349333    (if (pl-null? pl)
    350       pl
     334      '()
    351335      (pl-adjoin (car pl) (recur (cdr pl))))))
    352336
    353 (define (pl-flatten opt pl-tree)
    354   (let recur ((tree pl-tree) (result (sentinel opt)))
     337(define (pl-flatten pl-tree)
     338  (let recur ((tree pl-tree) (result '()))
    355339    (if (pair? tree)
    356340      (let ((head (car tree)) (tail (cdr tree)))
     
    362346      result)))
    363347
    364 ;;; (pl-collect ((var pl ok-xpr ...) ....) opt item-xpr)
    365 ;;; ------------------------------------------------
    366348(define-syntax pl-collect
    367349  (syntax-rules ()
    368    ;((_ ((var pl ok-xpr ...)) opt item-xpr)
    369    ((_ opt item-xpr (var pl ok-xpr ...))
     350   ((_ item-xpr (var pl ok-xpr ...))
    370351     (let recur ((seq pl))
    371352       (if (pl-null? seq)
    372          (sentinel opt)
     353         '()
    373354         (let ((var (car seq)))
    374355           (if (and ok-xpr ...)
    375356             (cons item-xpr (recur (cdr seq)))
    376357             (recur (cdr seq)))))))
    377    ;((_ ((var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
    378    ((_ opt item-xpr (var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...)
     358   ((_ item-xpr (var pl ok-xpr ...) (var1 pl1 ok-xpr1 ...) ...)
    379359    (let recur ((seq pl))
    380360      (if (pl-null? seq)
    381         (sentinel opt)
     361        '()
    382362        (let ((var (car seq)))
    383363          (if (and ok-xpr ...)
    384             (pl-append opt ;(pl-collect ((var1 pl1 ok-xpr1 ...) ...) opt item-xpr)
    385                        (pl-collect opt item-xpr (var1 pl1 ok-xpr1 ...) ...)
     364            (pl-append (pl-collect item-xpr (var1 pl1 ok-xpr1 ...) ...)
    386365                       (recur (cdr seq)))
    387366            (recur (cdr seq)))))))
    388367   ))
     368
    389369
    390370;;; (pseudolists sym ..)
     
    400380      "the first call returns all exported symbols,"
    401381      "the second documentation of symbol sym")
    402     (pl-maker
    403       procedure:
    404         (pl-maker opt . args)
    405         "creates a new pseudolist with (sentinel opt) from args")
    406382    (pl?
    407383      procedure:
     
    417393      procedure:
    418394        (pl-null? xpr)
    419         "is xpr pl-null?, i.e. not a pair")
     395        "is xpr an atom, i.e. not a pair?")
    420396    (pl-iterate
    421397      procedure:
    422       (pl-iterate opt fn k)
    423       (pl-iterate opt fn k init)
    424       "creates a pseudolist with (sentinel opt) applying fn to init"
     398      (pl-iterate fn k)
     399      (pl-iterate fn k init)
     400      "creates a list applying fn to init"
    425401      "recursively k times")
    426402    (pl-length
     
    468444    (pl-map
    469445      procedure:
    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)")
     446        (pl-map fn)
     447        (pl-map fn pl)
     448        "maps fn over the pseudolist pl and returns a new list")
    474449    (pl-index
    475450      procedure:
     
    485460    (pl-reverse
    486461      procedure:
    487       (pl-reverse opt pl)
    488       "reverses its pseudolist argument to a now one"
    489       "with (sentinel opt)")
     462      (pl-reverse pl)
     463      "reverses its pseudolist argument to a new list")
    490464    (pl-append
    491465      procedure:
    492       (pl-append opt pl . pls)
    493       "appends all argument pseudolists to a pseudolist"
    494       "with (sentinel opt)")
     466      (pl-append pl . pls)
     467      "appends all argument pseudolists to a list")
    495468    (pl-memp
    496469      procedure:
     470      (pl-memp ok?)
    497471      (pl-memp ok? pl)
    498       "returns the sub-pseudolist starting at the first"
    499       "item which passes the ok? test")
     472      "returns the sublist starting at the first"
     473      "item which passes the ok? test,"
     474      "returns #f if now item passes the ok? test")
    500475    (pl-member
    501476      procedure:
     477      (pl-member x)
    502478      (pl-member x pl)
    503479      "same as (pl-memp (cut equal? <> x) pl)")
    504480    (pl-memq
    505481      procedure:
     482      (pl-memq x)
    506483      (pl-memq x pl)
    507484      "same as (pl-memp (cut eq? <> x) pl)")
    508485    (pl-memv
    509486      procedure:
     487      (pl-memv x)
    510488      (pl-memv x pl)
    511489      "same as (pl-memp (cut eqv? <> x) pl)")
     
    538516        (pl-adjoin obj)
    539517        (pl-adjoin obj pl)
    540         "adds obj to a pseudolist, provided, it isn't already there")
     518        "adds obj to a pseudolist stripping the sentinel,"
     519        "provided, it isn't already there")
    541520    (pl-remove-dups
    542521      procedure:
    543522        (pl-remove-dups lst)
    544         "removes duplicates of a pseudolist")
     523        "removes duplicates of a pseudolist stripping the sentinel")
    545524    (pl-flatten
    546525      procedure:
    547         (pl-flatten opt pl-tree)
    548         "flattens the nested pseudolist tree to a"
    549         "pseudolist with (sentinel opt)")
     526        (pl-flatten pl-tree)
     527        "flattens the nested pseudolist tree to a list")
    550528    (pl-collect
    551529      macro:
    552       (pl-collect opt xpr (var pl ok-xpr ...) ....)
    553       "creates a new pseudolist with (sentinel opt) by binding var to each element"
     530      (pl-collect xpr (var pl ok-xpr ...) ....)
     531      "creates a new list by binding var to each element"
    554532      "of the pseudolist pl in sequence, and if it passes the checks,"
    555       "ok-xpr ..., inserts the value of xpr into the resulting pseudolist."
     533      "ok-xpr ..., inserts the value of xpr into the resulting list."
    556534      "The qualifieres, (var pl ok-xpr ...), are processed"
    557535      "sequentially from left to right, so that filters of a"
     
    571549
    572550;(import pseudolists simple-tests)
    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-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)))
    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 ;
     551 
  • release/5/pseudolists/trunk/tests/run.scm

    r37763 r37770  
    1111  ((pl-of? symbol?) '(a b . c))
    1212
    13   (equal? (pl-maker (Some-sentinel #f) 1 2 3 4)
    14           '(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))
     13  (equal? (pl-iterate add1 5 0) '(0 1 2 3 4))
    1814
    19   (not (pl-sentinel
    20          (pl-maker (Some-sentinel #f) 1 2 3 4)))
     15  (not (pl-sentinel '(1 2 3 4 . #f)))
    2116  (= (pl-sentinel '(0 1 2 3 2 . 2)) 2)
    22   (not (pl-sentinel '(0 1 2 3 . #f)))
     17 
    2318  (= (pl-length '(0 1 2 3 . 4)) 4)
    2419
     
    3631
    3732  (equal? (pl-drop 1 '(0 1 2 3 . 4))
    38           '(1 2 3 . 4))
    39   (= (pl-drop 0 1) 1)
    40   (equal? (pl-drop 2 '(0 1 2 3 . #f)) '(2 3 . #f))
    41   (equal? (pl-drop-while odd? '(1 3 2 4 . #f)) '(2 4 . #f))
    42   (equal? (pl-drop-while negative? '(1 3 2 4 . #f)) '(1 3 2 4 . #f))
     33          '(1 2 3))
     34  (null? (pl-drop 0 1))
     35  (equal? (pl-drop 2 '(0 1 2 3 . #f)) '(2 3))
     36  (equal? (pl-drop-while odd? '(1 3 2 4 . #f)) '(2 4))
     37  (equal? (pl-drop-while negative? '(1 3 2 4 . #f)) '(1 3 2 4))
    4338 
    44   (equal? (pl-take 3 '(0 1 2 3 4 . #t)) '(0 1 2 . #t))
    45   (equal? (pl-take 2 '(0 1 2 3 . #f)) '(0 1 . #f))
    46   (equal? (pl-take-while odd? '(1 3 2 4 . #f)) '(1 3 . #f))
     39  (equal? (pl-take 3 '(0 1 2 3 4 . #t)) '(0 1 2))
     40  (equal? (pl-take 2 '(0 1 2 3 . #f)) '(0 1))
     41  (equal? (pl-take-while odd? '(1 3 2 4 . #f)) '(1 3))
    4742  (null? (pl-take-while negative? '(1 3 2 4)))
    4843
    49   (= (pl-filter odd? 1) 1)
     44  (null? (pl-filter odd? 1))
    5045  (equal? (pl-filter odd? '(0 1 2 3 4)) '(1 3))
    51   (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))
     46  (equal? (pl-filter odd? '(0 1 2 3 . 4)) '(1 3))
     47  (equal? (pl-filter even? '(0 1 2 3 . 4)) '(0 2))
    5348 
    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)
     49  (equal? (pl-map add1 '(0 1 2 3 . 4)) '(1 2 3 4))
     50  (equal? (pl-map add1 '(0 1 2 3 . 4)) '(1 2 3 4))
     51  (equal? (pl-map add1 '(0 1 2 3)) '(1 2 3 4))
     52  (null? (pl-map add1 #f))
    5853
    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))
     54  (not (pl-memp odd? '(0 2 4 . #t)))
     55  (not (pl-memv 5 '(0 1 2 3 4 . 5)))
     56  (equal? (pl-member 3 '(0 1 2 3 4 . 5)) '(3 4))
    6357
    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))
     58  (equal? (pl-reverse '(0 1 2 3 . 4)) '(3 2 1 0))
     59  (equal? (pl-reverse '(0 1 2 3 . 4)) '(3 2 1 0))
     60  (equal? (pl-reverse '(0 1 2 3)) '(3 2 1 0))
     61
     62  (equal? (pl-append '(0 1) #f) '(0 1))
     63  (equal? (pl-append '(0 1)) '(0 1))
     64  (equal? (pl-append '(0 1) '(2 3) #f) '(0 1 2 3))
     65  (equal? (pl-append '(0 1 . #f) '(2 3)) '(0 1 2 3))
     66  (equal? (pl-append '(0 1) '(2 3) '(4 5)) '(0 1 2 3 4 5))
     67  (equal? (pl-append '(0 1 . #f) '(2 3 . #t) '(4 5)) '(0 1 2 3 4 5))
     68  (equal? (pl-append '(0 1 . #t) '(2 3 . #t) '(4 5 . #t)) '(0 1 2 3 4 5))
     69  (equal? (pl-append '(0 1 . #t) '(2 3 . #t) '(4 5) #t)
     70          '(0 1 2 3 4 5))
    7371
    7472  (= (pl-fold-right + 0 '(1 2 3 . #f)) 6)
    7573  (= (pl-fold-left + 0 '(1 2 3)) 6)
    7674
    77   (equal? (pl-adjoin 2 '(0 1 2 3 . #f)) '(0 1 2 3 . #f))
    78   (equal? (pl-adjoin 4 '(0 1 2 3 #f)) '(4 0 1 2 3 #f))
     75  (equal? (pl-adjoin 2 '(0 1 2 3 . #f)) '(0 1 2 3))
     76  (equal? (pl-adjoin 4 '(0 1 2 3 #f . #t)) '(4 0 1 2 3 #f))
    7977  (equal? (pl-adjoin 1 '(0 1 2 3)) '(0 1 2 3))
    80   (equal? (pl-adjoin 1 '()) '(1))
     78  (equal? (pl-adjoin 1 #f) '(1))
    8179
    82   (equal? (pl-remove-dups '(0 1 2 3 2 . 2)) '(0 1 3 2 . 2))
     80  (equal? (pl-remove-dups '(0 1 2 3 2 . 2)) '(0 1 3 2))
    8381  (equal? (pl-remove-dups '(0 1 2 3 2 2)) '(0 1 3 2))
    8482  (equal? (pl-remove-dups '(0 1 2 1 3 2)) '(0 1 3 2))
    8583
    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))
     84  (equal? (pl-flatten '(1 (2 3) . #t)) '(1 2 3))
     85  (equal? (pl-flatten '(1 (2 (3 . #f) . #t) . #f)) '(1 2 3))
     86  (null? (pl-flatten #f))
    9087 
    91   (equal? (pl-collect (Some-sentinel #t) (add1 x) (x '(0 1 2 3 . #f))) ; map
    92     '(1 2 3 4 . #t))
    93   (equal? (pl-collect (No-sentinel) (add1 x) (x '(0 1 2 3))) ; map
     88  (equal? (pl-collect (add1 x) (x '(0 1 2 3 . #f))) ; map
    9489    '(1 2 3 4))
    95   (equal? (pl-collect (Some-sentinel #t) x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
    96     '(1 3 5 . #t))
    97   (equal? (pl-collect (No-sentinel) x (x '(0 1 2 3 4 5) (odd? x))) ; filter
     90  (equal? (pl-collect (add1 x) (x '(0 1 2 3))) ; map
     91    '(1 2 3 4))
     92  (equal? (pl-collect x (x '(0 1 2 3 4 5 . #f) (odd? x))) ; filter
    9893    '(1 3 5))
    99   (equal? (pl-collect (No-sentinel) (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
     94  (equal? (pl-collect x (x '(0 1 2 3 4 5) (odd? x))) ; filter
     95    '(1 3 5))
     96  (equal? (pl-collect (* 10 n) (n '(0 1 2 3 4 5) (positive? n) (even? n)))
    10097    '(20 40))
    101   (equal? (pl-collect (No-sentinel) (list c k)
    102                   (c '(A B C))
    103                   (k '(1 2 3 4)))
     98  (equal? (pl-collect (list c k)
     99                      (c '(A B C))
     100                      (k '(1 2 3 4)))
    104101    '((A 1) (A 2) (A 3) (A 4)
    105102      (B 1) (B 2) (B 3) (B 4)
    106103      (C 1) (C 2) (C 3) (C 4)))
    107   (equal? (pl-collect (Some-sentinel #t) (list c k)
    108                   (c '(A B C . #f)) (k '(1 2 3 4 . #f)))
     104  (equal? (pl-collect (list c k)
     105                      (c '(A B C . #f))
     106                      (k '(1 2 3 4 . #f)))
    109107    '((A 1) (A 2) (A 3) (A 4)
    110108      (B 1) (B 2) (B 3) (B 4)
    111       (C 1) (C 2) (C 3) (C 4) . #t))
     109      (C 1) (C 2) (C 3) (C 4)))
    112110  )
    113111 
Note: See TracChangeset for help on using the changeset viewer.