Fixing a few bugs from drdr
This commit is contained in:
parent
fae0cb2c99
commit
debd6026f3
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require (only-in "private/list.rkt" split-at))
|
|
||||||
(provide first second third fourth fifth sixth seventh eighth ninth tenth
|
(provide first second third fourth fifth sixth seventh eighth ninth tenth
|
||||||
|
|
||||||
last-pair last rest
|
last-pair last rest
|
||||||
|
@ -107,6 +107,14 @@
|
||||||
[(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 (split-at list0 n0)
|
||||||
|
(unless (exact-nonnegative-integer? n0)
|
||||||
|
(raise-type-error 'split-at "non-negative exact integer" n0))
|
||||||
|
(let loop ([list list0] [n n0] [pfx '()])
|
||||||
|
(cond [(zero? n) (values (reverse pfx) list)]
|
||||||
|
[(pair? list) (loop (cdr list) (sub1 n) (cons (car list) pfx))]
|
||||||
|
[else (too-large 'split-at list0 n0)])))
|
||||||
|
|
||||||
(define (drop list n)
|
(define (drop list n)
|
||||||
;; could be defined as `list-tail', but this is better for errors anyway
|
;; could be defined as `list-tail', but this is better for errors anyway
|
||||||
(unless (exact-nonnegative-integer? n)
|
(unless (exact-nonnegative-integer? n)
|
||||||
|
|
|
@ -1,9 +1,7 @@
|
||||||
|
|
||||||
(module list "pre-base.rkt"
|
(module list "pre-base.rkt"
|
||||||
|
|
||||||
(provide split-at
|
(provide foldl
|
||||||
|
|
||||||
foldl
|
|
||||||
foldr
|
foldr
|
||||||
|
|
||||||
remv
|
remv
|
||||||
|
@ -26,19 +24,6 @@
|
||||||
build-list
|
build-list
|
||||||
|
|
||||||
compose)
|
compose)
|
||||||
|
|
||||||
(define (split-at list0 n0)
|
|
||||||
(unless (exact-nonnegative-integer? n0)
|
|
||||||
(raise-type-error 'split-at "non-negative exact integer" n0))
|
|
||||||
(let loop ([list list0] [n n0] [pfx '()])
|
|
||||||
(cond [(zero? n) (values (reverse pfx) list)]
|
|
||||||
[(pair? list) (loop (cdr list) (sub1 n) (cons (car list) pfx))]
|
|
||||||
[else
|
|
||||||
(raise-mismatch-error
|
|
||||||
'split-at
|
|
||||||
(format "index ~e too large for list~a: "
|
|
||||||
n0 (if (list? list0) "" " (not a proper list)"))
|
|
||||||
list0)])))
|
|
||||||
|
|
||||||
(#%require (rename "sort.rkt" raw-sort sort)
|
(#%require (rename "sort.rkt" raw-sort sort)
|
||||||
(for-syntax "stxcase-scheme.rkt"))
|
(for-syntax "stxcase-scheme.rkt"))
|
||||||
|
|
|
@ -39,8 +39,9 @@
|
||||||
[(v s)
|
[(v s)
|
||||||
(-seqn-cons (values v) s)]
|
(-seqn-cons (values v) s)]
|
||||||
[vs*s
|
[vs*s
|
||||||
(define-values (vs sl) (split-at vs*s (sub1 (length vs*s))))
|
; XXX double reverse is bad but moving split-at causes a problem I can't figure
|
||||||
(-seqn-cons (apply values vs) (car sl))]))
|
(define s*vs (reverse vs*s))
|
||||||
|
(-seqn-cons (apply values (reverse (cdr s*vs))) (car s*vs))]))
|
||||||
|
|
||||||
(define (seqn-first s)
|
(define (seqn-first s)
|
||||||
(define-values (more? next) (sequence-generate s))
|
(define-values (more? next) (sequence-generate s))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user