Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 04:55:04 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added (do)

Browse source
This commit is contained in:
Justin Ethier 2016-01-28 23:02:17 -05:00
parent 510c5ec2a7
commit 5d0d055aba
1 changed files with 28 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
scheme/base.sld
View file

@ -98,6 +98,7 @@
case case
cond cond
cond-expand cond-expand
do
when when
quasiquote quasiquote
floor floor
@ -120,10 +121,7 @@
; ;=> ; ;=>
; ;bytevector-u8-set! ; ;bytevector-u8-set!
; ;current-error-port ; ;current-error-port
; ;define
; ;define-syntax
; ;define-values ; ;define-values
; ;else
; ;error-object-irritants ; ;error-object-irritants
; ;error-object-message ; ;error-object-message
; ;error-object? ; ;error-object?
@ -143,7 +141,6 @@
; ;read-bytevector! ; ;read-bytevector!
; ;read-error? ; ;read-error?
; ;read-u8 ; ;read-u8
; ;string-set!
; ;symbol=? ; ;symbol=?
; ;syntax-rules ; ;syntax-rules
; ;truncate-quotient ; ;truncate-quotient
@ -153,9 +150,7 @@
; ;unquote ; ;unquote
; ;unquote-splicing ; ;unquote-splicing
; ;write-u8 ; ;write-u8
; apply
; binary-port? ; binary-port?
; boolean?
; bytevector ; bytevector
; bytevector-append ; bytevector-append
; bytevector-copy ; bytevector-copy
@ -172,7 +167,6 @@
; current-error-port ; current-error-port
; define-record-type ; define-record-type
; denominator ; denominator
; do
; eof-object ; eof-object
; eof-object? ; eof-object?
; eq? ; eq?
@ -426,6 +420,33 @@
`(if ,(cadr exp) `(if ,(cadr exp)
((lambda () ,@(cddr exp))) ((lambda () ,@(cddr exp)))
#f)))) #f))))
(define-syntax do
(er-macro-transformer
(lambda (expr rename compare)
(let* ((body
`(,(rename 'begin)
,@(cdr (cddr expr))
(,(rename 'lp)
,@(map (lambda (x)
(if (pair? (cddr x))
(if (pair? (cdr (cddr x)))
(error "too many forms in do iterator" x)
(car (cddr x)))
(car x)))
(cadr expr)))))
(check (car (cddr expr)))
(wrap
(if (null? (cdr check))
`(,(rename 'let) ((,(rename 'tmp) ,(car check)))
(,(rename 'if) ,(rename 'tmp)
,(rename 'tmp)
,body))
`(,(rename 'if) ,(car check)
(,(rename 'begin) ,@(cdr check))
,body))))
`(,(rename 'let) ,(rename 'lp)
,(map (lambda (x) (list (car x) (cadr x))) (cadr expr))
,wrap)))))
(define-syntax quasiquote (define-syntax quasiquote
(er-macro-transformer (er-macro-transformer
;; Based on the quasiquote macro from Chibi scheme ;; Based on the quasiquote macro from Chibi scheme