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

Actually swap the argument order.

Browse Source 
(This was supposed to be included with the other commit.)
This commit is contained in:
Eli Barzilay 2013-03-09 16:05:01 -05:00
parent c183711d34
commit 44c274e6c3
2 changed files with 16 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/racket/list.rkt
View File

@ -135,9 +135,9 @@
[(pair? list) (loop (cdr list) (sub1 n) (cons (car list) pfx))]
[else (too-large 'split-at list0 n0)])))
(define (takef pred list)
(define (takef list pred)
(unless (procedure? pred)
(raise-argument-error 'takef "procedure?" 0 pred list))
(raise-argument-error 'takef "procedure?" 0 list pred))
(let loop ([list list])
(if (pair? list)
(let ([x (car list)])
@ -145,21 +145,21 @@
(cons x (loop (cdr list)))
'()))
;; could return `list' here, but make it behave like `take'
;; exmaple: (takef symbol? '(a b c . d)) should be similar
;; exmaple: (takef '(a b c . d) symbol?) should be similar
;; to (take '(a b c . d) 3)
'())))
(define (dropf pred list)
(define (dropf list pred)
(unless (procedure? pred)
(raise-argument-error 'dropf "procedure?" 0 pred list))
(raise-argument-error 'dropf "procedure?" 0 list pred))
(let loop ([list list])
(if (and (pair? list) (pred (car list)))
(loop (cdr list))
list)))
(define (splitf-at pred list)
(define (splitf-at list pred)
(unless (procedure? pred)
(raise-argument-error 'splitf-at "procedure?" 0 pred list))
(raise-argument-error 'splitf-at "procedure?" 0 list pred))
(let loop ([list list] [pfx '()])
(if (and (pair? list) (pred (car list)))
(loop (cdr list) (cons (car list) pfx))
@ -213,9 +213,9 @@
;; one -- reverse the list, look for the place where the predicate flips
;; to #f, then use the non-f from-right functions above to do the work.
(define (count-from-right who pred list)
(define (count-from-right who list pred)
(unless (procedure? pred)
(raise-argument-error who "procedure?" 0 pred list))
(raise-argument-error who "procedure?" 0 list pred))
(let loop ([list list] [rev '()] [n 0])
(if (pair? list)
(loop (cdr list) (cons (car list) rev) (add1 n))
@ -224,12 +224,12 @@
(loop (sub1 n) (cdr list))
n)))))
(define (takef-right pred list)
(drop list (count-from-right 'takef-right pred list)))
(define (dropf-right pred list)
(take list (count-from-right 'dropf-right pred list)))
(define (splitf-at-right pred list)
(split-at list (count-from-right 'splitf-at-right pred list)))
(define (takef-right list pred)
(drop list (count-from-right 'takef-right list pred)))
(define (dropf-right list pred)
(take list (count-from-right 'dropf-right list pred)))
(define (splitf-at-right list pred)
(split-at list (count-from-right 'splitf-at-right list pred)))
(define append*
(case-lambda [(ls) (apply append ls)] ; optimize common case

22
collects/tests/racket/list.rktl
View File

@ -244,7 +244,7 @@
,(list (list-ref t 1) (list-ref t 2))
,(list (list-ref t 4) (list-ref t 3)))]
[fun ffuns])
(test expect fun symbol? (car t)))
(test expect fun (car t) symbol?))
(for ([fun (append funs ffuns)])
(arity-test fun 2 2)
(err/rt-test (fun 1 1) exn:application:mismatch?)
@ -254,26 +254,6 @@
(err/rt-test (fun '(1) 2) exn:application:mismatch?)
(err/rt-test (fun '(1 2 . 3) 3) exn:application:mismatch?)))
;; ---------- takef/dropf ----------
#;(let ()
(define list-1 '(2 4 6 8 1 3 5))
(err/rt-test (takef 5 '()) exn:application:mismatch?)
(err/rt-test (dropf 5 '()) exn:application:mismatch?)
(err/rt-test (takef even? 1) exn:application:mismatch?)
(err/rt-test (dropf even? 1) exn:application:mismatch?)
(define (vals f . xs) (call-with-values (λ() (apply f xs)) list))
(define (t pred take-l drop-l)
(define l (append take-l drop-l))
(test take-l takef pred l)
(test drop-l dropf pred l)
(test (list take-l drop-l) vals splitf-at pred l))
(t even? '() '())
(t even? '(2 4) '(5 7))
(t even? '(2 4 6 8) '())
(t even? '() '(1 3 5))
(t symbol? '(a b c) '(1 2 3 x y z)))
;; ---------- append* ----------
(let ()
(test '() append* '())