;;; srfi-1.scm --- List Library
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 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,
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 2.1 of the License, or (at your option) any later version.
+;;
+;; This library 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
-;;
-;; As a special exception, the Free Software Foundation gives permission
-;; for additional uses of the text contained in its release of GUILE.
-;;
-;; The exception is that, if you link the GUILE library with other files
-;; to produce an executable, this does not by itself cause the
-;; resulting executable to be covered by the GNU General Public License.
-;; Your use of that executable is in no way restricted on account of
-;; linking the GUILE library code into it.
-;;
-;; This exception does not however invalidate any other reasons why
-;; the executable file might be covered by the GNU General Public License.
-;;
-;; This exception applies only to the code released by the
-;; Free Software Foundation under the name GUILE. If you copy
-;; code from other Free Software Foundation releases into a copy of
-;; GUILE, as the General Public License permits, the exception does
-;; not apply to the code that you add in this way. To avoid misleading
-;; anyone as to the status of such modified files, you must delete
-;; this exception notice from them.
-;;
-;; If you write modifications of your own for GUILE, it is your choice
-;; whether to permit this exception to apply to your modifications.
-;; If you do not wish that, delete this exception notice.
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Author: Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;; Date: 2001-06-06
(define-module (srfi srfi-1)
:use-module (ice-9 session)
- :use-module (ice-9 receive))
-
-(export
+ :use-module (ice-9 receive)
+ :export (
;;; Constructors
;; cons <= in the core
;; list <= in the core
;; cons* <= in the core
;; make-list <= in the core
list-tabulate
- ;; list-copy <= in the core
+ list-copy
circular-list
- iota ; Extended.
+ ;; iota ; Extended.
;;; Predicates
proper-list?
reduce-right
unfold
unfold-right
- map ; Extended.
- for-each ; Extended.
+ ;; map ; Extended.
+ ;; for-each ; Extended.
append-map
append-map!
map!
- map-in-order ; Extended.
+ ;; map-in-order ; Extended.
pair-for-each
filter-map
;;; Filtering & partitioning
- filter
+ ;; filter <= in the core
partition
remove
- filter!
+ ;; filter! <= in the core
partition!
remove!
break!
any
every
- list-index ; Extended.
- member ; Extended.
+ ;; list-index ; Extended.
+ ;; member ; Extended.
;; memq <= in the core
;; memv <= in the core
;;; Deletion
- delete ; Extended.
- delete! ; Extended.
+ ;; delete ; Extended.
+ ;; delete! ; Extended.
delete-duplicates
delete-duplicates!
;;; Association lists
- assoc ; Extended.
+ ;; assoc ; Extended.
;; assq <= in the core
;; assv <= in the core
alist-cons
;; set-car! <= in the core
;; set-cdr! <= in the core
)
+ :re-export (cons list cons* make-list pair? null?
+ car cdr caar cadr cdar cddr
+ caaar caadr cadar caddr cdaar cdadr cddar cdddr
+ caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+ cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+ list-ref last-pair length append append! reverse reverse!
+ filter filter! memq memv assq assv set-car! set-cdr!)
+ :replace (iota map for-each map-in-order list-copy list-index member
+ delete delete! assoc)
+ )
(cond-expand-provide (current-module) '(srfi-1))
(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)
;;; Miscelleneous: length, append, concatenate, reverse, zip & count
-(define (length+ clist)
- (if (null? clist)
- 0
- (let lp ((hare (cdr clist)) (tortoise clist) (l 1))
- (if (null? hare)
- l
- (let ((hare (cdr hare)))
- (if (null? hare)
- (+ l 1)
- (if (eq? hare tortoise)
- #f
- (lp (cdr hare) (cdr tortoise) (+ l 2)))))))))
-
-(define (concatenate l-o-l)
- (let lp ((l l-o-l) (acc '()))
- (if (null? l)
- (reverse! acc)
- (let lp0 ((ll (car l)) (acc acc))
- (if (null? ll)
- (lp (cdr l) acc)
- (lp0 (cdr ll) (cons (car ll) acc)))))))
-
-(define (concatenate! l-o-l)
- (let lp0 ((l-o-l l-o-l))
- (cond
- ((null? l-o-l)
- '())
- ((null? (car l-o-l))
- (lp0 (cdr l-o-l)))
- (else
- (let ((result (car l-o-l)) (tail (last-pair (car l-o-l))))
- (let lp ((l (cdr l-o-l)) (ntail tail))
- (if (null? l)
- result
- (begin
- (set-cdr! ntail (car l))
- (lp (cdr l) (last-pair ntail))))))))))
-
-
(define (append-reverse rev-head tail)
(let lp ((l rev-head) (acc tail))
(if (null? l)
;; Internal helper procedure. Map `f' over the single list `ls'.
;;
-(define (map1 f ls)
- (if (null? ls)
- ls
- (let ((ret (list (f (car ls)))))
- (let lp ((ls (cdr ls)) (p ret)) ; tail pointer
- (if (null? ls)
- ret
- (begin
- (set-cdr! p (list (f (car ls))))
- (lp (cdr ls) (cdr p))))))))
+(define map1 map)
(define (append-map f clist1 . rest)
(if (null? rest)
;;; Filtering & partitioning
-(define (filter pred list)
- (check-arg-type list? list "filter") ; reject circular lists.
- (letrec ((filiter (lambda (pred rest result)
- (if (null? rest)
- (reverse! result)
- (filiter pred (cdr rest)
- (cond ((pred (car rest))
- (cons (car rest) result))
- (else
- result)))))))
- (filiter pred list '())))
-
-(define (partition pred list)
- (if (null? list)
- (values '() '())
- (if (pred (car list))
- (receive (in out) (partition pred (cdr list))
- (values (cons (car list) in) out))
- (receive (in out) (partition pred (cdr list))
- (values in (cons (car list) out))))))
-
(define (remove pred list)
(filter (lambda (x) (not (pred x))) list))
-(define (filter! pred list)
- (filter pred list)) ; XXX:optimize
-
(define (partition! pred list)
(partition pred list)) ; XXX:optimize
(else
(lp (map1 cdr lists) (+ i 1)))))))
-;;; Deletion
-
-(define (delete x list . rest)
- (let ((l= (if (pair? rest) (car rest) equal?)))
- (let lp ((l list))
- (if (null? l)
- '()
- (if (l= (car l) x)
- (lp (cdr l))
- (cons (car l) (lp (cdr l))))))))
-
-(define (delete! x list . rest)
- (let ((l= (if (pair? rest) (car rest) equal?)))
- (delete x list l=))) ; XXX:optimize
-
-(define (delete-duplicates list . rest)
- (let ((l= (if (pair? rest) (car rest) equal?)))
- (let lp0 ((l1 list))
- (if (null? l1)
- '()
- (if (let lp1 ((l2 (cdr l1)))
- (if (null? l2)
- #f
- (if (l= (car l1) (car l2))
- #t
- (lp1 (cdr l2)))))
- (lp0 (cdr l1))
- (cons (car l1) (lp0 (cdr l1))))))))
-
-(define (delete-duplicates list . rest)
- (let ((l= (if (pair? rest) (car rest) equal?)))
- (let lp ((list list))
- (if (null? list)
- '()
- (cons (car list) (lp (delete (car list) (cdr list) l=)))))))
-
-(define (delete-duplicates! list . rest)
- (let ((l= (if (pair? rest) (car rest) equal?)))
- (delete-duplicates list l=))) ; XXX:optimize
-
;;; Association lists
-(define (assoc key alist . rest)
- (let ((k= (if (pair? rest) (car rest) equal?)))
- (let lp ((a alist))
- (if (null? a)
- #f
- (if (k= key (caar a))
- (car a)
- (lp (cdr a)))))))
-
(define (alist-cons key datum alist)
(acons key datum alist))
HCoop / bpt / guile.git / blobdiff