suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added last-pair and tests

Browse Source 
svn: r9422

original commit: 13c5e3812d252bab985f29210862308ae8623396
This commit is contained in:
Eli Barzilay 2008-04-23 13:20:05 +00:00
parent 821142782e
commit e523655315
1 changed files with 92 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

193
collects/mzlib/list.ss
View File

@ -1,120 +1,111 @@
#lang mzscheme
(module list mzscheme
;; The `first', etc. operations in this library
;; work on pairs, not lists.
;; The `first', etc. operations in this library
;; work on pairs, not lists.
(require (only scheme/base
foldl
foldr
(require (only scheme/base
foldl
foldr
remv
remq
remove
remv*
remq*
remove*
remv
remq
remove
remv*
remq*
remove*
findf
memf
assf
findf
memf
assf
filter
filter
sort)
(only scheme/list
cons?
empty?
empty
last-pair))
sort)
(only scheme/list
cons?
empty?
empty))
(provide first
second
third
fourth
fifth
sixth
seventh
eighth
(provide first
second
third
fourth
fifth
sixth
seventh
eighth
rest
rest
cons?
empty
empty?
cons?
empty
empty?
foldl
foldr
foldl
foldr
last-pair
last-pair
remv
remq
remove
remv*
remq*
remove*
remv
remq
remove
remv*
remq*
remove*
assf
memf
findf
assf
memf
findf
filter
filter
quicksort ; deprecated
mergesort ; deprecated
sort
merge-sorted-lists)
quicksort ; deprecated
mergesort ; deprecated
sort
merge-sorted-lists)
;; a non-destructive version for symmetry with merge-sorted-lists!
(define (merge-sorted-lists a b less?)
(cond [(null? a) b]
[(null? b) a]
[else (let loop ([x (car a)] [a (cdr a)] [y (car b)] [b (cdr b)])
;; The loop handles the merging of non-empty lists. It has
;; been written this way to save testing and car/cdring.
(if (less? y x)
(if (null? b)
(list* y x a)
(cons y (loop x a (car b) (cdr b))))
;; x <= y
(if (null? a)
(list* x y b)
(cons x (loop (car a) (cdr a) y b)))))]))
;; a non-destructive version for symmetry with merge-sorted-lists!
(define (merge-sorted-lists a b less?)
(cond [(null? a) b]
[(null? b) a]
[else (let loop ([x (car a)] [a (cdr a)] [y (car b)] [b (cdr b)])
;; The loop handles the merging of non-empty lists. It has
;; been written this way to save testing and car/cdring.
(if (less? y x)
(if (null? b)
(list* y x a)
(cons y (loop x a (car b) (cdr b))))
;; x <= y
(if (null? a)
(list* x y b)
(cons x (loop (car a) (cdr a) y b)))))]))
;; deprecated!
(define quicksort sort)
(define mergesort sort)
;; deprecated!
(define quicksort sort)
(define mergesort sort)
(define (first x)
(unless (pair? x) (raise-type-error 'first "non-empty list" x))
(car x))
(define-syntax define-lgetter
(syntax-rules ()
[(_ name npos)
(define (name l0)
(let loop ([l l0] [pos npos])
(if (pair? l)
(if (eq? pos 1) (car l) (loop (cdr l) (sub1 pos)))
(raise-type-error
'name (format "list with ~a or more items" npos) l0))))]))
(define-lgetter second 2)
(define-lgetter third 3)
(define-lgetter fourth 4)
(define-lgetter fifth 5)
(define-lgetter sixth 6)
(define-lgetter seventh 7)
(define-lgetter eighth 8)
(define (rest x)
(unless (pair? x)
(raise-type-error 'rest "non-empty list" x))
(cdr x))
(define (last-pair l)
(if (pair? l)
(let loop ([l l] [x (cdr l)])
(if (pair? x)
(loop x (cdr x))
l))
(raise-type-error 'last-pair "pair" l))))
(define (first x)
(unless (pair? x) (raise-type-error 'first "non-empty list" x))
(car x))
(define-syntax define-lgetter
(syntax-rules ()
[(_ name npos)
(define (name l0)
(let loop ([l l0] [pos npos])
(if (pair? l)
(if (eq? pos 1) (car l) (loop (cdr l) (sub1 pos)))
(raise-type-error
'name (format "list with ~a or more items" npos) l0))))]))
(define-lgetter second 2)
(define-lgetter third 3)
(define-lgetter fourth 4)
(define-lgetter fifth 5)
(define-lgetter sixth 6)
(define-lgetter seventh 7)
(define-lgetter eighth 8)
(define (rest x)
(unless (pair? x)
(raise-type-error 'rest "non-empty list" x))
(cdr x))