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

11
piclib/built-in.scm
View File

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

78
piclib/srfi/1.scm
View File

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