Changeset 31238 in project


Ignore:
Timestamp:
08/18/14 14:35:07 (5 years ago)
Author:
juergen
Message:

typed-lists version 1.2 added list-cons-sorted

Location:
release/4/typed-lists
Files:
3 edited
5 copied

Legend:

Unmodified
Added
Removed
  • release/4/typed-lists/tags/1.2/tests/run.scm

    r31233 r31238  
    122122    (not (list-sorted? <= (typed-list 2 0 1 4 3)))
    123123    (list-sorted? <= (typed-list 0 1 2 3 4))
     124    (list-equal?
     125      (list-cons-sorted <= 2 (typed-list 0 1 2 3 4))
     126      (typed-list 0 1 2 2 3 4))
     127    (list-equal?
     128      (list-cons-sorted <= 5 (typed-list 0 1 2 3 4))
     129      (typed-list 0 1 2 3 4 5))
    124130    (list-every? odd? (typed-list 1 3 5))
    125131    (list-every? odd? (typed-list))
  • release/4/typed-lists/tags/1.2/typed-lists.scm

    r31233 r31238  
    4343   list-from-upto list-split-at list-split-with list-equal? list-member
    4444   list-memp list-remp list-remove list-remove-dups list-assp list-assoc
    45    list-filter list-fold-left list-fold-right list-merge list-sort list-sorted?
     45   list-filter list-fold-left list-fold-right list-merge list-sort
     46   list-sorted? list-cons-sorted
    4647   list-drop list-drop-while list-take list-take-while list-repeat list-iterate
    4748   list-iterate-while list-iterate-until list-zip list-interpose list-every?
     
    476477          (loop ls0 (list-rest ls1) (list-cons (list-first ls1) result))))
    477478      )))
     479
    478480(define (list-sort <? lst)
    479481  (let loop ((ls lst))
     
    486488                   (loop head)
    487489                   (loop tail)))))))
     490
    488491(define (list-sorted? <? lst)
    489492  (let loop ((ls lst))
     
    496499           (loop rest))
    497500          (else #f))))))
     501
     502(define (list-cons-sorted <? item lst)
     503  (if (list-sorted? <? lst)
     504    (let loop ((lst lst))
     505      (cases typed-list lst
     506        (list-null () (list-cons item (list-null)))
     507        (list-cons (first rest)
     508          (if (<? item first)
     509            (list-apply typed-list item first rest)
     510            (list-cons first (loop rest))))))
     511    (error 'list-cons-sorted "argument list not sorted" lst)))
    498512
    499513(define (list-zip lst0 lst1)
     
    599613      (list-sort <? tlst)
    600614      (list-sorted? <? tlst)
     615      (list-cons-sorted <? item tlst)
    601616      (list-zip tlst0 tlst1)
    602617      (list-interpose sep tlst)
  • release/4/typed-lists/tags/1.2/typed-lists.setup

    r31233 r31238  
    77 'typed-lists
    88 '("typed-lists.so" "typed-lists.import.so")
    9  '((version "1.1")))
     9 '((version "1.2")))
    1010
  • release/4/typed-lists/trunk/tests/run.scm

    r31233 r31238  
    122122    (not (list-sorted? <= (typed-list 2 0 1 4 3)))
    123123    (list-sorted? <= (typed-list 0 1 2 3 4))
     124    (list-equal?
     125      (list-cons-sorted <= 2 (typed-list 0 1 2 3 4))
     126      (typed-list 0 1 2 2 3 4))
     127    (list-equal?
     128      (list-cons-sorted <= 5 (typed-list 0 1 2 3 4))
     129      (typed-list 0 1 2 3 4 5))
    124130    (list-every? odd? (typed-list 1 3 5))
    125131    (list-every? odd? (typed-list))
  • release/4/typed-lists/trunk/typed-lists.scm

    r31233 r31238  
    4343   list-from-upto list-split-at list-split-with list-equal? list-member
    4444   list-memp list-remp list-remove list-remove-dups list-assp list-assoc
    45    list-filter list-fold-left list-fold-right list-merge list-sort list-sorted?
     45   list-filter list-fold-left list-fold-right list-merge list-sort
     46   list-sorted? list-cons-sorted
    4647   list-drop list-drop-while list-take list-take-while list-repeat list-iterate
    4748   list-iterate-while list-iterate-until list-zip list-interpose list-every?
     
    476477          (loop ls0 (list-rest ls1) (list-cons (list-first ls1) result))))
    477478      )))
     479
    478480(define (list-sort <? lst)
    479481  (let loop ((ls lst))
     
    486488                   (loop head)
    487489                   (loop tail)))))))
     490
    488491(define (list-sorted? <? lst)
    489492  (let loop ((ls lst))
     
    496499           (loop rest))
    497500          (else #f))))))
     501
     502(define (list-cons-sorted <? item lst)
     503  (if (list-sorted? <? lst)
     504    (let loop ((lst lst))
     505      (cases typed-list lst
     506        (list-null () (list-cons item (list-null)))
     507        (list-cons (first rest)
     508          (if (<? item first)
     509            (list-apply typed-list item first rest)
     510            (list-cons first (loop rest))))))
     511    (error 'list-cons-sorted "argument list not sorted" lst)))
    498512
    499513(define (list-zip lst0 lst1)
     
    599613      (list-sort <? tlst)
    600614      (list-sorted? <? tlst)
     615      (list-cons-sorted <? item tlst)
    601616      (list-zip tlst0 tlst1)
    602617      (list-interpose sep tlst)
  • release/4/typed-lists/trunk/typed-lists.setup

    r31233 r31238  
    77 'typed-lists
    88 '("typed-lists.so" "typed-lists.import.so")
    9  '((version "1.1")))
     9 '((version "1.2")))
    1010
Note: See TracChangeset for help on using the changeset viewer.