unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* 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).