diff options
author | Daniel Llorens <lloda@sarc.name> | 2019-12-06 14:14:30 +0100 |
---|---|---|
committer | Daniel Llorens <lloda@sarc.name> | 2019-12-06 14:14:30 +0100 |
commit | 2b6083865a69c44c09ac493cb4a1d65fffb83d81 (patch) | |
tree | fe4e6fc072e84a360afe8eb7f1c58b5d5f2760d0 /module/srfi | |
parent | c6a9a7e7754243bf7c7b7fc295f7afa4216319cb (diff) | |
download | guile-2b6083865a69c44c09ac493cb4a1d65fffb83d81.tar.gz |
Single definition of (iota)
* module/ice-9/boot-9.scm (iota): Fix to be SRFI-1 compatible.
* module/srfi/srfi-1.scm: Re-export iota.
Diffstat (limited to 'module/srfi')
-rw-r--r-- | module/srfi/srfi-1.scm | 30 |
1 files changed, 12 insertions, 18 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 0806e7363..c0ee53548 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -6,12 +6,12 @@ ;; modify it under the terms of the GNU Lesser General Public ;; License as published by the Free Software Foundation; either ;; version 3 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 ;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA @@ -48,7 +48,7 @@ list-tabulate list-copy circular-list - ;; iota ; Extended. + ;; iota <= in the core ;;; Predicates proper-list? @@ -216,8 +216,9 @@ 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 + filter filter! memq memv assq assv set-car! set-cdr! + iota) + :replace (map for-each map-in-order list-copy list-index member delete delete! assoc) ) @@ -266,13 +267,6 @@ INIT-PROC is applied to the indices is not specified." (set-cdr! (last-pair elts) elts) elts) -(define* (iota count #:optional (start 0) (step 1)) - (check-arg non-negative-integer? count iota) - (let lp ((n 0) (acc '())) - (if (= n count) - (reverse! acc) - (lp (+ n 1) (cons (+ start (* n step)) acc))))) - ;;; Predicates (define (proper-list? x) @@ -363,7 +357,7 @@ end-of-list checking in contexts where dotted lists are allowed." (define take list-head) (define drop list-tail) -;;; TAKE-RIGHT and DROP-RIGHT work by getting two pointers into the list, +;;; TAKE-RIGHT and DROP-RIGHT work by getting two pointers into the list, ;;; off by K, then chasing down the list until the lead pointer falls off ;;; the end. Note that they diverge for circular lists. @@ -591,7 +585,7 @@ has just one element then that's the return value." (if (pair? l) (cons (f (car l)) (map1 (cdr l))) '()))) - + ((f l1 l2) (check-arg procedure? f map) (let* ((len1 (length+ l1)) @@ -677,7 +671,7 @@ has just one element then that's the return value." (define (append-map f clist1 . rest) (concatenate (apply map f clist1 rest))) - + (define (append-map! f clist1 . rest) (concatenate! (apply map f clist1 rest))) @@ -913,7 +907,7 @@ and those making the associations." ;; relying on memq/memv to check that = is a procedure. ((eq? = eq?) (memq x ls)) ((eq? = eqv?) (memv x ls)) - (else + (else (check-arg procedure? = member) (find-tail (lambda (y) (= x y)) ls)))) @@ -961,7 +955,7 @@ given REST parameters." (begin (check-arg procedure? = lset-adjoin) (lambda (x y) (= y x))))) - + (let lp ((ans list) (rest rest)) (if (null? rest) ans @@ -978,7 +972,7 @@ given REST parameters." (begin (check-arg procedure? = lset-union) (lambda (x y) (= y x))))) - + (fold (lambda (lis ans) ; Compute ANS + LIS. (cond ((null? lis) ans) ; Don't copy any lists ((null? ans) lis) ; if we don't have to. |