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

Fix for new macro system.

Browse Source 
This may reduce the quality of the generated source locations, but
I didn't want to add too much complexity to this PR.
This commit is contained in:
Sam Tobin-Hochstadt 2015-10-21 12:49:43 -04:00
parent 4db245c00d
commit 19b3d09237
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)])
; tag-exprs-list = ( (tag_1 (e1 ...)) (tag_2 (e2 ...)) ... )
(with-syntax ([go (syntax-local-introduce (syntax/loc stx go))]
[return (syntax-local-introduce (syntax/loc stx return))])
#`((let/cc go
(let ([return (lambda (v) (go (lambda () v)))])
(with-syntax ([go-id (datum->syntax stx 'go)]
[return-id (datum->syntax stx 'return)])
#`((let/cc go-id
(let ([return-id (lambda (v) (go-id (lambda () v)))])
(letrec
(#,@(map generate-binding
(drop-right tag-exprs-list 1)
(cdr tags))
#,(generate-last-binding (last tag-exprs-list) #'return))
#,(generate-last-binding (last tag-exprs-list) #'return-id))
(#,first-tag))))))))]))
(module+ test (require rackunit))