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

.

Browse Source 
original commit: 85c0849c44e3e7cbc106a923729989b6132d8975
This commit is contained in:
Matthew Flatt 2000-08-04 14:38:36 +00:00
parent eb096f689a
commit a79decf25e
1 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/mzlib/functior.ss
View File

@ -250,13 +250,26 @@
(unless (pair? x)
(raise-type-error 'first "non-empty list" x))
(car x))))
(define second (polymorphic (lambda (x) (cadr x))))
(define third (polymorphic (lambda (x) (caddr x))))
(define fourth (polymorphic (lambda (x) (cadddr x))))
(define fifth (polymorphic (lambda (x) (fourth (cdr x)))))
(define sixth (polymorphic (lambda (x) (fourth (cddr x)))))
(define seventh (polymorphic (lambda (x) (fourth (cdddr x)))))
(define eighth (polymorphic (lambda (x) (fourth (cddddr x)))))
(define (lget name npos)
(lambda (x)
(let loop ([l x][pos npos])
(cond
[(and (= pos 1) (pair? l))
(car l)]
[(pair? l)
(loop (cdr l) (sub1 pos))]
[else
(raise-type-error name
(format "list with ~a or more items" npos)
x)]))))
(define second (polymorphic (lget 'second 2)))
(define third (polymorphic (lget 'third 3)))
(define fourth (polymorphic (lget 'fourth 4)))
(define fifth (polymorphic (lget 'fifth 5)))
(define sixth (polymorphic (lget 'sixth 6)))
(define seventh (polymorphic (lget 'seventh 7)))
(define eighth (polymorphic (lget 'eighth 8)))
(define rest (polymorphic (lambda (x)
(unless (pair? x)