artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

implement let loop.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-16 19:10:04 +02:00
parent b638d33e4b
commit 47fd339305
2 changed files with 22 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
scm.mes
View file

@ -62,10 +62,19 @@
(#t (split-values (cdr bindings) (#t (split-values (cdr bindings)
(append values (cdar bindings) '()))))) (append values (cdar bindings) '())))))
(define-macro (let bindings . body) (define-macro (simple-let bindings rest)
`((lambda ,(split-params bindings '()) ,@body) `((lambda ,(split-params bindings '()) ,@rest)
,@(split-values bindings '()))) ,@(split-values bindings '())))
(define-macro (let-loop label bindings rest)
`(let ((,label (lambda ,(split-params bindings '()) ,@rest)))
(,label ,@(split-values bindings '()))))
(define-macro (let bindings-or-label . rest)
`(if ,(symbol? bindings-or-label)
(let-loop ,bindings-or-label ,(car rest) ,(cdr rest))
(simple-let ,bindings-or-label ,rest)))
(define (expand-let* bindings body) (define (expand-let* bindings body)
(cond ((null? bindings) (cond ((null? bindings)
`((lambda () ,@body))) `((lambda () ,@body)))

11
test.mes
View file

@ -81,6 +81,17 @@
(display 'let-dun) (display 'let-dun)
(newline) (newline)
(let loop ((lst '(3 2 1)))
(display "loop")
(newline)
(if (null? lst) (begin (display "dun") 'dun)
(begin
(display "looping: ")
(display (car lst))
(newline)
(loop (cdr lst)))))
(newline)
(define c 'b) (define c 'b)
`(aa bb ,c) `(aa bb ,c)
(display `(pp qq ,c)) (display `(pp qq ,c))