From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: srfi-1 take and drop Date: Tue, 06 May 2003 09:14:05 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87y91lt29u.fsf@zip.com.au> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1052176869 25491 80.91.224.249 (5 May 2003 23:21:09 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 5 May 2003 23:21:09 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue May 06 01:21:08 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19CpGe-0006d1-00 for ; Tue, 06 May 2003 01:21:08 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 19CpFX-0004Lu-00 for guile-devel@m.gmane.org; Mon, 05 May 2003 19:19:59 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10.13) id 19CpCb-00039x-00 for guile-devel@gnu.org; Mon, 05 May 2003 19:16:57 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10.13) id 19CpCM-0002vg-00 for guile-devel@gnu.org; Mon, 05 May 2003 19:16:45 -0400 Original-Received: from snoopy.pacific.net.au ([61.8.0.36]) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 19CpAZ-0001mR-00 for guile-devel@gnu.org; Mon, 05 May 2003 19:14:53 -0400 Original-Received: from sunny.pacific.net.au (sunny.pacific.net.au [203.2.228.40]) h45NEGJS003951 for ; Tue, 6 May 2003 09:14:22 +1000 Original-Received: from wisma.pacific.net.au (wisma.pacific.net.au [210.23.129.72]) by sunny.pacific.net.au with ESMTP id h45NEGQg024131 for ; Tue, 6 May 2003 09:14:16 +1000 (EST) Original-Received: from localhost (ppp27.dyn228.pacific.net.au [203.143.228.27]) by wisma.pacific.net.au (8.12.9/8.12.9) with ESMTP id h45NEEYZ014352 for ; Tue, 6 May 2003 09:14:14 +1000 (EST) Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 19Cp9p-0001EW-00; Tue, 06 May 2003 09:14:05 +1000 Original-To: guile-devel@gnu.org User-Agent: Gnus/5.090019 (Oort Gnus v0.19) Emacs/21.2 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:2268 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2268 --=-=-= 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. --=-=-= Content-Disposition: attachment; filename=srfi-1.test ;;;; 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)))) --=-=-= Content-Disposition: attachment; filename=srfi-1.scm.take-drop.diff --- 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) --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--