* srfi-1 take and drop
@ 2003-05-05 23:14 Kevin Ryde
2003-05-06 1:30 ` Rob Browning
0 siblings, 1 reply; 10+ messages in thread
From: Kevin Ryde @ 2003-05-05 23:14 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 617 bytes --]
Am I right that srfi-1 take and drop are the same as the core
list-head and list-tail? In which case perhaps,
* srfi-1.scm (take): Make this an alias for list-head.
(drop): Make this an alias for list-tail.
* tests/srfi-1.test: New file, exercising take and drop.
* Makefile.am (SCM_TESTS): Add it.
The only difference I could spot in the current implementations was
list-head and list-tail throw an exception for negative n, where take
and drop code quietly treat that as 0. srfi-1 doesn't say anything
about negatives as far as I can tell, so presumably there's a free
choice.
[-- Attachment #2: srfi-1.test --]
[-- Type: text/plain, Size: 3598 bytes --]
;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
;;;;
;;;; Copyright 2003 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
(use-modules (srfi srfi-1)
(test-suite lib))
;;
;; drop
;;
(with-test-prefix "drop"
(pass-if "'() 0"
(null? (drop '() 0)))
(pass-if "'(a) 0"
(let ((lst '(a)))
(eq? lst
(drop lst 0))))
(pass-if "'(a b) 0"
(let ((lst '(a b)))
(eq? lst
(drop lst 0))))
(pass-if "'(a) 1"
(let ((lst '(a)))
(eq? (cdr lst)
(drop lst 1))))
(pass-if "'(a b) 1"
(let ((lst '(a b)))
(eq? (cdr lst)
(drop lst 1))))
(pass-if "'(a b) 2"
(let ((lst '(a b)))
(eq? (cddr lst)
(drop lst 2))))
(pass-if "'(a b c) 1"
(let ((lst '(a b c)))
(eq? (cddr lst)
(drop lst 2))))
(pass-if "circular '(a) 0"
(let ((lst (circular-list 'a)))
(eq? lst
(drop lst 0))))
(pass-if "circular '(a) 1"
(let ((lst (circular-list 'a)))
(eq? lst
(drop lst 1))))
(pass-if "circular '(a) 2"
(let ((lst (circular-list 'a)))
(eq? lst
(drop lst 1))))
(pass-if "circular '(a b) 1"
(let ((lst (circular-list 'a)))
(eq? (cdr lst)
(drop lst 0))))
(pass-if "circular '(a b) 2"
(let ((lst (circular-list 'a)))
(eq? lst
(drop lst 1))))
(pass-if "circular '(a b) 5"
(let ((lst (circular-list 'a)))
(eq? (cdr lst)
(drop lst 5))))
(pass-if "'(a . b) 1"
(eq? 'b
(drop '(a . b) 1)))
(pass-if "'(a b . c) 1"
(equal? 'c
(drop '(a b . c) 2))))
;;
;; take
;;
(with-test-prefix "take"
(pass-if "'() 0"
(null? (take '() 0)))
(pass-if "'(a) 0"
(null? (take '(a) 0)))
(pass-if "'(a b) 0"
(null? (take '() 0)))
(pass-if "'(a b c) 0"
(null? (take '() 0)))
(pass-if "'(a) 1"
(let* ((lst '(a))
(got (take lst 1)))
(and (equal? '(a) got)
(not (eq? lst got)))))
(pass-if "'(a b) 1"
(equal? '(a)
(take '(a b) 1)))
(pass-if "'(a b c) 1"
(equal? '(a)
(take '(a b c) 1)))
(pass-if "'(a b) 2"
(let* ((lst '(a b))
(got (take lst 2)))
(and (equal? '(a b) got)
(not (eq? lst got)))))
(pass-if "'(a b c) 2"
(equal? '(a b)
(take '(a b c) 2)))
(pass-if "circular '(a) 0"
(equal? '()
(take (circular-list 'a) 0)))
(pass-if "circular '(a) 1"
(equal? '(a)
(take (circular-list 'a) 1)))
(pass-if "circular '(a) 2"
(equal? '(a a)
(take (circular-list 'a) 2)))
(pass-if "circular '(a b) 5"
(equal? '(a b a b a)
(take (circular-list 'a 'b) 5)))
(pass-if "'(a . b) 1"
(equal? '(a)
(take '(a . b) 1)))
(pass-if "'(a b . c) 1"
(equal? '(a)
(take '(a b . c) 1)))
(pass-if "'(a b . c) 2"
(equal? '(a b)
(take '(a b . c) 2))))
[-- Attachment #3: srfi-1.scm.take-drop.diff --]
[-- Type: text/plain, Size: 559 bytes --]
--- srfi-1.scm.~1.22.~ 2003-04-28 07:51:30.000000000 +1000
+++ srfi-1.scm 2003-05-05 11:23:36.000000000 +1000
@@ -347,16 +347,9 @@
(define (car+cdr x) (values (car x) (cdr x)))
-(define (take x i)
- (let lp ((n i) (l x) (acc '()))
- (if (<= n 0)
- (reverse! acc)
- (lp (- n 1) (cdr l) (cons (car l) acc)))))
-(define (drop x i)
- (let lp ((n i) (l x))
- (if (<= n 0)
- l
- (lp (- n 1) (cdr l)))))
+(define take list-head)
+(define drop list-tail)
+
(define (take-right flist i)
(let lp ((n i) (l flist))
(if (<= n 0)
[-- Attachment #4: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-05 23:14 srfi-1 take and drop Kevin Ryde
@ 2003-05-06 1:30 ` Rob Browning
2003-05-06 1:58 ` Kevin Ryde
0 siblings, 1 reply; 10+ messages in thread
From: Rob Browning @ 2003-05-06 1:30 UTC (permalink / raw)
Cc: guile-devel
Kevin Ryde <user42@zip.com.au> writes:
> The only difference I could spot in the current implementations was
> list-head and list-tail throw an exception for negative n, where take
> and drop code quietly treat that as 0. srfi-1 doesn't say anything
> about negatives as far as I can tell, so presumably there's a free
> choice.
I was planning on doing a little hacking on srfi-1.scm too, and I'd
thought about checking and throwing an error on negative n for various
functions, but I hadn't decided. One thing I was planning to do was
alter null-list? to be less careful. The spec doesn't require it, and
what we do now is more expensive.
--
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-06 1:30 ` Rob Browning
@ 2003-05-06 1:58 ` Kevin Ryde
2003-05-06 3:02 ` Rob Browning
2003-05-06 3:04 ` Rob Browning
0 siblings, 2 replies; 10+ messages in thread
From: Kevin Ryde @ 2003-05-06 1:58 UTC (permalink / raw)
Rob Browning <rlb@defaultvalue.org> writes:
>
> I was planning on doing a little hacking on srfi-1.scm too,
I arrived in srfi-1 because I managed to hit a stack overflow in
delete-duplicates on just a few hundred elements, then got to looking
around at what was there.
I've written some non-tail-recursive C versions of delete and delete!,
and I've got a bit towards delete-duplicates, delete-duplicates! and
alist-copy. I guess a lot of stuff could be coded in C, but start at
least with things that will show a definite benefit.
> One thing I was planning to do was alter null-list? to be less
> careful. The spec doesn't require it, and what we do now is more
> expensive.
Does the spec say it has to chase down to check it's not an improper
list? I guess at least that can be done in one loop and not separate
proper-list? and circular-list? calls.
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-06 1:58 ` Kevin Ryde
@ 2003-05-06 3:02 ` Rob Browning
2003-05-06 3:04 ` Rob Browning
1 sibling, 0 replies; 10+ messages in thread
From: Rob Browning @ 2003-05-06 3:02 UTC (permalink / raw)
Cc: guile-devel
Kevin Ryde <user42@zip.com.au> writes:
> Does the spec say it has to chase down to check it's not an improper
> list? I guess at least that can be done in one loop and not separate
> proper-list? and circular-list? calls.
(define (null-list? l)
(not (pair? l)))
is actually correct according to the spec.
--
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-06 1:58 ` Kevin Ryde
2003-05-06 3:02 ` Rob Browning
@ 2003-05-06 3:04 ` Rob Browning
2003-05-08 0:00 ` Kevin Ryde
2003-05-08 16:12 ` Paul Jarc
1 sibling, 2 replies; 10+ messages in thread
From: Rob Browning @ 2003-05-06 3:04 UTC (permalink / raw)
Cc: guile-devel
Kevin Ryde <user42@zip.com.au> writes:
> I arrived in srfi-1 because I managed to hit a stack overflow in
> delete-duplicates on just a few hundred elements, then got to looking
> around at what was there.
Yep, I have a "take" I haven't committed yet that avoids both stack
growth and reverse! by tracking the end pair...
--
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-06 3:04 ` Rob Browning
@ 2003-05-08 0:00 ` Kevin Ryde
2003-05-08 16:37 ` Rob Browning
2003-05-08 16:12 ` Paul Jarc
1 sibling, 1 reply; 10+ messages in thread
From: Kevin Ryde @ 2003-05-08 0:00 UTC (permalink / raw)
Rob Browning <rlb@defaultvalue.org> writes:
>
> Yep, I have a "take" I haven't committed yet that avoids both stack
> growth and reverse! by tracking the end pair...
Is that the same as what list-head does (in C)?
Can save some work ... :-).
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-06 3:04 ` Rob Browning
2003-05-08 0:00 ` Kevin Ryde
@ 2003-05-08 16:12 ` Paul Jarc
2003-05-08 16:35 ` Rob Browning
1 sibling, 1 reply; 10+ messages in thread
From: Paul Jarc @ 2003-05-08 16:12 UTC (permalink / raw)
Cc: guile-devel
Rob Browning <rlb@defaultvalue.org> wrote:
> Yep, I have a "take" I haven't committed yet that avoids both stack
> growth and reverse! by tracking the end pair...
Are you using (ice-9 q)? It seems to be the right tool for that job.
paul
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-08 16:12 ` Paul Jarc
@ 2003-05-08 16:35 ` Rob Browning
0 siblings, 0 replies; 10+ messages in thread
From: Rob Browning @ 2003-05-08 16:35 UTC (permalink / raw)
Cc: guile-devel
prj@po.cwru.edu (Paul Jarc) writes:
> Rob Browning <rlb@defaultvalue.org> wrote:
>> Yep, I have a "take" I haven't committed yet that avoids both stack
>> growth and reverse! by tracking the end pair...
>
> Are you using (ice-9 q)? It seems to be the right tool for that job.
Nope. Didn't even know that was there. I had just done this as a
first pass:
(define (take lst k)
;; avoid a reverse! or stack growth -- easy on the cache,
;; hard on the eyes...
(cond
((zero? k) '())
((negative? k) (error "negative count in call to take."))
(else
(let ((result (cons (car lst) '())))
(let lp ((n (- k 1)) (rest (cdr lst)) (end-pair result))
(if (zero? n)
result
(let ((new-end (cons (car rest) '())))
(set-cdr! end-pair new-end)
(lp (- n 1) (cdr rest) new-end))))))))
though thanks for pointing out (ice-9 q). That might be a better idea...
--
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-08 0:00 ` Kevin Ryde
@ 2003-05-08 16:37 ` Rob Browning
2003-05-09 22:38 ` Kevin Ryde
0 siblings, 1 reply; 10+ messages in thread
From: Rob Browning @ 2003-05-08 16:37 UTC (permalink / raw)
Cc: guile-devel
Kevin Ryde <user42@zip.com.au> writes:
> Is that the same as what list-head does (in C)?
> Can save some work ... :-).
Looks like it might. If so, it'd be faster too.
Thanks
--
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: srfi-1 take and drop
2003-05-08 16:37 ` Rob Browning
@ 2003-05-09 22:38 ` Kevin Ryde
0 siblings, 0 replies; 10+ messages in thread
From: Kevin Ryde @ 2003-05-09 22:38 UTC (permalink / raw)
Rob Browning <rlb@defaultvalue.org> writes:
>
> Looks like it might. If so, it'd be faster too.
I applied the change I posted.
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2003-05-09 22:38 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-05-05 23:14 srfi-1 take and drop Kevin Ryde
2003-05-06 1:30 ` Rob Browning
2003-05-06 1:58 ` Kevin Ryde
2003-05-06 3:02 ` Rob Browning
2003-05-06 3:04 ` Rob Browning
2003-05-08 0:00 ` Kevin Ryde
2003-05-08 16:37 ` Rob Browning
2003-05-09 22:38 ` Kevin Ryde
2003-05-08 16:12 ` Paul Jarc
2003-05-08 16:35 ` Rob Browning
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).