suzanne.soy/control
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #2 from samth/fix-new-macro

Browse Source 
Fix for new macro system.
This commit is contained in:
Jens Axel Søgaard 2015-10-21 18:52:35 +02:00
commit b37124b8f2
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
control/tagged-begin.rkt
View File

@ -110,15 +110,15 @@
] ]
[tags (map car tag-exprs-list)]) [tags (map car tag-exprs-list)])
; tag-exprs-list = ( (tag_1 (e1 ...)) (tag_2 (e2 ...)) ... ) ; tag-exprs-list = ( (tag_1 (e1 ...)) (tag_2 (e2 ...)) ... )
(with-syntax ([go (syntax-local-introduce (syntax/loc stx go))] (with-syntax ([go-id (datum->syntax stx 'go)]
[return (syntax-local-introduce (syntax/loc stx return))]) [return-id (datum->syntax stx 'return)])
#`((let/cc go #`((let/cc go-id
(let ([return (lambda (v) (go (lambda () v)))]) (let ([return-id (lambda (v) (go-id (lambda () v)))])
(letrec (letrec
(#,@(map generate-binding (#,@(map generate-binding
(drop-right tag-exprs-list 1) (drop-right tag-exprs-list 1)
(cdr tags)) (cdr tags))
#,(generate-last-binding (last tag-exprs-list) #'return)) #,(generate-last-binding (last tag-exprs-list) #'return-id))
(#,first-tag))))))))])) (#,first-tag))))))))]))
(module+ test (require rackunit)) (module+ test (require rackunit))