From a79decf25e541face20664f05b47b1d6ce5aab4a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 4 Aug 2000 14:38:36 +0000 Subject: [PATCH] . original commit: 85c0849c44e3e7cbc106a923729989b6132d8975 --- collects/mzlib/functior.ss | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/collects/mzlib/functior.ss b/collects/mzlib/functior.ss index 62c39a3..8780ba7 100644 --- a/collects/mzlib/functior.ss +++ b/collects/mzlib/functior.ss @@ -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)