Shuffle code for a more logical order.

This commit is contained in:
Eli Barzilay 2013-03-08 22:03:57 -05:00
parent e47cc6efb1
commit 0d217af2f0

View File

@ -13,10 +13,10 @@
drop drop
take take
split-at split-at
drop-right
take-right
takef takef
dropf dropf
drop-right
take-right
split-at-right split-at-right
append* append*
@ -117,6 +117,12 @@
[(pair? list) (cons (car list) (loop (cdr list) (sub1 n)))] [(pair? list) (cons (car list) (loop (cdr list) (sub1 n)))]
[else (too-large 'take list0 n0)]))) [else (too-large 'take list0 n0)])))
(define (drop list n)
;; could be defined as `list-tail', but this is better for errors anyway
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'drop "exact-nonnegative-integer?" 1 list n))
(or (drop* list n) (too-large 'drop list n)))
(define (split-at list0 n0) (define (split-at list0 n0)
(unless (exact-nonnegative-integer? n0) (unless (exact-nonnegative-integer? n0)
(raise-argument-error 'split-at "exact-nonnegative-integer?" 1 list0 n0)) (raise-argument-error 'split-at "exact-nonnegative-integer?" 1 list0 n0))
@ -125,34 +131,6 @@
[(pair? list) (loop (cdr list) (sub1 n) (cons (car list) pfx))] [(pair? list) (loop (cdr list) (sub1 n) (cons (car list) pfx))]
[else (too-large 'split-at list0 n0)]))) [else (too-large 'split-at list0 n0)])))
(define (drop list n)
;; could be defined as `list-tail', but this is better for errors anyway
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'drop "exact-nonnegative-integer?" 1 list n))
(or (drop* list n) (too-large 'drop list n)))
;; take/drop-right are originally from srfi-1, uses the same lead-pointer trick
(define (take-right list n)
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'take-right "exact-nonnegative-integer?" 1 list n))
(let loop ([list list]
[lead (or (drop* list n) (too-large 'take-right list n))])
;; could throw an error for non-lists, but be more like `take'
(if (pair? lead)
(loop (cdr list) (cdr lead))
list)))
(define (drop-right list n)
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'drop-right "exact-nonnegative-integer?" n))
(let loop ([list list]
[lead (or (drop* list n) (too-large 'drop-right list n))])
;; could throw an error for non-lists, but be more like `drop'
(if (pair? lead)
(cons (car list) (loop (cdr list) (cdr lead)))
'())))
(define (takef pred list) (define (takef pred list)
(unless (procedure? pred) (unless (procedure? pred)
(raise-argument-error 'takef "procedure?" 0 pred list)) (raise-argument-error 'takef "procedure?" 0 pred list))
@ -176,6 +154,28 @@
[(pred (car list)) (loop (cdr list))] [(pred (car list)) (loop (cdr list))]
[else list]))) [else list])))
;; take/drop-right are originally from srfi-1, uses the same lead-pointer trick
(define (take-right list n)
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'take-right "exact-nonnegative-integer?" 1 list n))
(let loop ([list list]
[lead (or (drop* list n) (too-large 'take-right list n))])
;; could throw an error for non-lists, but be more like `take'
(if (pair? lead)
(loop (cdr list) (cdr lead))
list)))
(define (drop-right list n)
(unless (exact-nonnegative-integer? n)
(raise-argument-error 'drop-right "exact-nonnegative-integer?" n))
(let loop ([list list]
[lead (or (drop* list n) (too-large 'drop-right list n))])
;; could throw an error for non-lists, but be more like `drop'
(if (pair? lead)
(cons (car list) (loop (cdr list) (cdr lead)))
'())))
(define (split-at-right list n) (define (split-at-right list n)
(unless (exact-nonnegative-integer? n) (unless (exact-nonnegative-integer? n)
(raise-argument-error 'split-at-right "exact-nonnegative-integer?" n)) (raise-argument-error 'split-at-right "exact-nonnegative-integer?" n))