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

map may take multiple list

This commit is contained in:
Yuichi Nishiwaki 2013-11-14 22:16:30 +09:00
parent cc1adb93ce
commit a272f9d27c
1 changed files with 20 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
piclib/built-in.scm
View File

@ -131,11 +131,27 @@
(cons (car obj) (cons (car obj)
(list-copy (cdr obj))))) (list-copy (cdr obj)))))
(define (map f list) (define (every pred list)
(if (null? list) (if (null? list)
'() #t
(cons (f (car list)) (if (pred (car list))
(map f (cdr list))))) (every pred (cdr list))
#f)))
(define (map f list . lists)
(define (single-map f list)
(if (null? list)
'()
(cons (f (car list))
(map f (cdr list)))))
(define (multiple-map f lists)
(if (every pair? lists)
(cons (apply f (single-map car lists))
(multiple-map f (single-map cdr lists)))
'()))
(if (null? lists)
(single-map f list)
(multiple-map f (cons list lists))))
(define-macro (let bindings . body) (define-macro (let bindings . body)
(if (symbol? bindings) (if (symbol? bindings)
@ -331,24 +347,12 @@
;;; 6.3 Booleans ;;; 6.3 Booleans
(define (boolean=? . objs) (define (boolean=? . objs)
(define (every pred list)
(if (null? list)
#t
(if (pred (car list))
(every pred (cdr list))
#f)))
(or (every (lambda (x) (eq? x #t)) objs) (or (every (lambda (x) (eq? x #t)) objs)
(every (lambda (x) (eq? x #f)) objs))) (every (lambda (x) (eq? x #f)) objs)))
;;; 6.5. Symbols ;;; 6.5. Symbols
(define (symbol=? . objs) (define (symbol=? . objs)
(define (every pred list)
(if (null? list)
#t
(if (pred (car list))
(every pred (cdr list))
#f)))
(let ((sym (car objs))) (let ((sym (car objs)))
(if (symbol? sym) (if (symbol? sym)
(every (lambda (x) (every (lambda (x)