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 (require (only scheme/base
;; work on pairs, not lists. foldl
foldr
(require (only scheme/base remv
foldl remq
foldr remove
remv*
remq*
remove*
remv findf
remq memf
remove assf
remv*
remq*
remove*
findf filter
memf
assf
filter sort)
(only scheme/list
cons?
empty?
empty
last-pair))
sort) (provide first
(only scheme/list second
cons? third
empty? fourth
empty)) fifth
sixth
seventh
eighth
(provide first rest
second
third
fourth
fifth
sixth
seventh
eighth
rest cons?
empty
empty?
cons? foldl
empty foldr
empty?
foldl last-pair
foldr
last-pair remv
remq
remove
remv*
remq*
remove*
remv assf
remq memf
remove findf
remv*
remq*
remove*
assf filter
memf
findf
filter quicksort ; deprecated
mergesort ; deprecated
sort
merge-sorted-lists)
quicksort ; deprecated ;; a non-destructive version for symmetry with merge-sorted-lists!
mergesort ; deprecated (define (merge-sorted-lists a b less?)
sort (cond [(null? a) b]
merge-sorted-lists) [(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! ;; deprecated!
(define (merge-sorted-lists a b less?) (define quicksort sort)
(cond [(null? a) b] (define mergesort sort)
[(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 (first x)
(define quicksort sort) (unless (pair? x) (raise-type-error 'first "non-empty list" x))
(define mergesort sort) (car x))
(define-syntax define-lgetter
(define (first x) (syntax-rules ()
(unless (pair? x) (raise-type-error 'first "non-empty list" x)) [(_ name npos)
(car x)) (define (name l0)
(define-syntax define-lgetter (let loop ([l l0] [pos npos])
(syntax-rules () (if (pair? l)
[(_ name npos) (if (eq? pos 1) (car l) (loop (cdr l) (sub1 pos)))
(define (name l0) (raise-type-error
(let loop ([l l0] [pos npos]) 'name (format "list with ~a or more items" npos) l0))))]))
(if (pair? l) (define-lgetter second 2)
(if (eq? pos 1) (car l) (loop (cdr l) (sub1 pos))) (define-lgetter third 3)
(raise-type-error (define-lgetter fourth 4)
'name (format "list with ~a or more items" npos) l0))))])) (define-lgetter fifth 5)
(define-lgetter second 2) (define-lgetter sixth 6)
(define-lgetter third 3) (define-lgetter seventh 7)
(define-lgetter fourth 4) (define-lgetter eighth 8)
(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 (rest x)
(unless (pair? x)
(raise-type-error 'rest "non-empty list" x))
(cdr x))