Skip to content

Instantly share code, notes, and snippets.

@shirok
Created December 7, 2012 21:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save shirok/4236623 to your computer and use it in GitHub Desktop.
Save shirok/4236623 to your computer and use it in GitHub Desktop.
(define-module util.toplevel-let
(export toplevel-let))
(select-module util.toplevel-let)
(define-syntax toplevel-let
(syntax-rules (define-toplevel define)
[(_ "loop" () binds0 binds1 tops)
(define-values tops (let binds0 (letrec binds1 (values . tops))))]
[(_ "loop" ((define-toplevel (name . args) . body) . xs)
binds0 (bind ...) (tops ...))
(toplevel-let "loop" xs binds0
(bind ... (name (lambda args . body)))
(tops ... name))]
[(_ "loop" ((define (name . args) . body) . xs)
binds0 (bind ...) tops)
(toplevel-let "loop" xs binds0
(bind ... (name (lambda args . body)))
tops)]
[(_ "loop" ((define-toplevel name expr1) . xs)
binds0 (bind ...) (tops ...))
(toplevel-let "loop" xs binds0
(bind ... (name expr1))
(tops ... name))]
[(_ "loop" ((define name expr1) . xs)
binds0 (bind ...) tops)
(toplevel-let "loop" xs binds0
(bind ... (name expr1))
tops)]
[(_ "loop" (expr1 . xs) binds0 (bind ...) tops)
(toplevel-let "loop" xs binds0 (bind ... (tmp expr1)) tops)]
;; entry
[(_ binds0 expr ...)
(toplevel-let "loop" (expr ...) binds0 () ())]))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment