conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

resolve redefinition warnings

This commit is contained in:
Yuichi Nishiwaki 2014-03-25 14:39:44 +09:00
parent a7ff80090b
commit 794c87b870
2 changed files with 40 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
piclib/built-in.scm
View File

@ -380,11 +380,12 @@
(define real-vector? vector?)
(define (vector? x)
(set! vector?
(lambda (x)
(and (real-vector? x)
(or (= 0 (vector-length x))
(not (eq? (vector-ref x 0)
record-marker)))))
record-marker))))))
#|
;; (scheme eval) is not provided for now

58
piclib/srfi/1.scm
View File

@ -208,10 +208,11 @@
(set-cdr! lst acc)
(rec rst lst)))))
(define (append-reverse rev-head tail)
(set! append-reverse
(lambda (rev-head tail)
(if (null? rev-head)
tail
(append-reverse (cdr rev-head) (cons (car rev-head) tail))))
(append-reverse (cdr rev-head) (cons (car rev-head) tail)))))
(define (append-reverse! rev-head tail)
(let ((rst (cdr rev-head)))
@ -353,8 +354,14 @@
(define (append-map! f . clists)
(apply append! (apply map f clists)))
;; means for inter-referential definition
(define pair-for-each #f)
(define (pair-for-each f clist . clists)
(if (null? clist)
(let rec ((clist clist))
(if (pair? clist)
(begin (f (car clist)) (rec (cdr clist)))))
(let rec ((clists (cons clist clists)))
(if (every pair? clists)
(begin (apply f (map car clists)) (rec (map cdr clists)))))))
(define (map! f list . lists)
(if (null? lists)
@ -379,15 +386,6 @@
(cons* (apply f (map car clists)) acc))
(reverse! acc)))))
(define (pair-for-each f clist . clists)
(if (null? clist)
(let rec ((clist clist))
(if (pair? clist)
(begin (f (car clist)) (rec (cdr clist)))))
(let rec ((clists (cons clist clists)))
(if (every pair? clists)
(begin (apply f (map car clists)) (rec (map cdr clists)))))))
(define (filter-map f clist . clists)
(if (null? clists)
(let rec ((clist clist) (cont values))
@ -416,16 +414,13 @@
(filter pred (cdr list)))
(filter pred (cdr list)))))
;; means for inter-referential definition
(define remove #f)
(define (remove pred list)
(filter (lambda (x) (not (pred x))) list))
(define (partition pred list)
(values (filter pred list)
(remove pred list)))
(define (remove pred list)
(filter (lambda (x) (not (pred x))) list))
(define (filter! pred list)
(let rec ((lst list))
(if (null? lst)
@ -435,16 +430,13 @@
lst)
(rec (cdr lst))))))
;; means for inter-referential definition
(define remove! #f)
(define (remove! pred list)
(filter! (lambda (x) (not (pred x))) list))
(define (partition! pred list)
(values (filter! pred list)
(remove! pred list)))
(define (remove! pred list)
(filter! (lambda (x) (not (pred x))) list))
(export filter partition remove
filter! partition! remove!)
@ -456,15 +448,6 @@
;; take-while drop-while take-while!
;; span break span! break!
;; means for inter-referential definition
(define find-tail #f)
(define (find pred list)
(let ((tail (find-tail pred list)))
(if tail
(car tail)
#f)))
(define (find-tail pred list)
(if (null? list)
#f
@ -472,6 +455,12 @@
list
(find-tail pred (cdr list)))))
(define (find pred list)
(let ((tail (find-tail pred list)))
(if tail
(car tail)
#f)))
(define (take-while pred clist)
(let rec ((clist clist) (cont values))
(if (null? clist)
@ -525,7 +514,8 @@
(or (apply pred (map car clists))
(rec (map cdr clists)))))))
(define (every pred clist . clists)
(set! every
(lambda (pred clist . clists)
(if (null? clists)
(let rec ((clist clist))
(or (null? clist)
@ -534,7 +524,7 @@
(let rec ((clists (cons clist clists)))
(or (any null? clists)
(if (apply pred (map car clists))
(rec (map cdr clists)))))))
(rec (map cdr clists))))))))
(define (list-index pred clist . clists)
(if (null? clists)