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

fix #38

This commit is contained in:
Yuichi Nishiwaki 2014-02-11 21:35:56 +09:00
parent c2a1ea6748
commit 634c9e0e2f
1 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
piclib/built-in.scm
View File

@ -85,26 +85,40 @@
(cons (r 'begin) (cdar clauses)) (cons (r 'begin) (cdar clauses))
(cons (r 'cond) (cdr clauses))))))))) (cons (r 'cond) (cdr clauses)))))))))
(define (single? list)
(if (pair? list)
(null? (cdr list))
#f))
(define-syntax and (define-syntax and
(er-macro-transformer (er-macro-transformer
(lambda (expr r compare) (lambda (expr r compare)
(let ((exprs (cdr expr))) (let ((exprs (cdr expr)))
(if (null? exprs) (cond
#t ((null? exprs)
(list (r 'if) (car exprs) #t)
(cons (r 'and) (cdr exprs)) ((single? exprs)
#f)))))) (car exprs))
(else
(list (r 'let) (list (list (r 'it) (car exprs)))
(list (r 'if) (r 'it)
(cons (r 'and) (cdr exprs))
(r 'it)))))))))
(define-syntax or (define-syntax or
(er-macro-transformer (er-macro-transformer
(lambda (expr r compare) (lambda (expr r compare)
(let ((exprs (cdr expr))) (let ((exprs (cdr expr)))
(if (null? exprs) (cond
#f ((null? exprs)
(list (r 'let) (list (list (r 'it) (car exprs))) #t)
(list (r 'if) (r 'it) ((single? exprs)
(r 'it) (car exprs))
(cons (r 'or) (cdr exprs))))))))) (else
(list (r 'let) (list (list (r 'it) (car exprs)))
(list (r 'if) (r 'it)
(r 'it)
(cons (r 'or) (cdr exprs))))))))))
(define-syntax quasiquote (define-syntax quasiquote
(er-macro-transformer (er-macro-transformer