diff --git a/collects/scheme/list.ss b/collects/scheme/list.ss index c2d2662568..9ebf3de5bf 100644 --- a/collects/scheme/list.ss +++ b/collects/scheme/list.ss @@ -1,61 +1,53 @@ +#lang scheme/base -(module list scheme/base +(provide first second third fourth fifth sixth seventh eighth ninth tenth + last - (provide first - second - third - fourth - fifth - sixth - seventh - eighth - last + rest - rest + cons? + empty + empty?) - cons? - empty - empty?) +(define (first x) + (if (and (pair? x) (list? x)) + (car x) + (raise-type-error 'first "non-empty list" x))) - (define (first x) - (unless (and (pair? x) - (list? x)) - (raise-type-error 'first "non-empty list" x)) - (car x)) +(define-syntax define-lgetter + (syntax-rules () + [(_ name npos) + (define (name l0) + (if (list? 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))) + (raise-type-error 'name "list" 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-lgetter ninth 9) +(define-lgetter tenth 10) - (define-syntax define-lgetter - (syntax-rules () - [(_ name npos) - (define (name l0) - (if (list? 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))) - (raise-type-error 'name "list" 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 (last l) + (if (and (pair? l) (list? l)) + (let loop ([l l]) + (if (pair? (cdr l)) + (loop (cdr l)) + (car l))) + (raise-type-error 'last "non-empty list" l))) - (define (last x) - (unless (and (pair? x) - (list? x)) - (raise-type-error 'last "non-empty list" x)) - (let loop ([x x]) - (if (pair? (cdr x)) - (loop (cdr x)) - (car x)))) +(define (rest l) + (if (and (pair? l) (list? l)) + (cdr l) + (raise-type-error 'rest "non-empty list" l))) - (define (rest x) - (unless (and (pair? x) - (list? x)) - (raise-type-error 'rest "non-empty list" x)) - (cdr x)) - - (define cons? (lambda (x) (pair? x))) - (define empty? (lambda (x) (null? x))) - (define empty '())) +(define cons? (lambda (l) (pair? l))) +(define empty? (lambda (l) (null? l))) +(define empty '()) diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index 92a80369c9..1325aa0a4f 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -461,6 +461,10 @@ Like @scheme[assoc], but finds an element using the predicate @defproc[(eighth [lst list?]) any]{Returns the eighth element of the list.} +@defproc[(ninth [lst list?]) any]{Returns the ninth element of the list.} + +@defproc[(tenth [lst list?]) any]{Returns the tenth element of the list.} + @defproc[(last [lst list?]) any]{Returns the last element of the list.} @; ----------------------------------------