diff options
| -rw-r--r-- | make_sweet_macros.py | 55 | ||||
| -rw-r--r-- | scheme/sweet-macros.sls | 12 |
2 files changed, 65 insertions, 2 deletions
diff --git a/make_sweet_macros.py b/make_sweet_macros.py new file mode 100644 index 0000000..abecddc --- /dev/null +++ b/make_sweet_macros.py @@ -0,0 +1,55 @@ +import os, shutil +from scheme2rst import SNIPPET + +code = file('scheme/sweet-macros.sls').read() + +# LOCAL, GUARDED-SYNTAX-CASE, SYNTAX-MATCH, DEF-SYNTAX, SYNTAX-EXPAND +snippets = [s.groups() for s in SNIPPET.finditer(code)] +snippet = dict(snippets) + +helper1 = '''#!r6rs +(library (sweet-macros helper1) +(export local guarded-syntax-case) +(import (rnrs)) + +%(LOCAL)s + +%(GUARDED-SYNTAX-CASE)s +) +''' + +helper2 = '''#!r6rs +(library (sweet-macros helper2) +(export local guarded-syntax-case syntax-match) +(import (rnrs) (for (sweet-macros helper1) run expand)) + +%(SYNTAX-MATCH)s +) +''' + +main = '''#!r6rs +(library (sweet-macros) +(export local guarded-syntax-case syntax-match def-syntax syntax-expand) +(import (rnrs) (for (sweet-macros helper2) run expand)) + +%(DEF-SYNTAX)s + +%(SYNTAX-EXPAND)s +) +''' + +def makedir(name, snippet): + try: + shutil.rmtree(name) + except OSError: + pass # already removed + os.mkdir(name) + file(name + '/helper1.sls', 'w').write(helper1 % snippet) + file(name + '/helper2.sls', 'w').write(helper2 % snippet) + file(name + '/main.sls', 'w').write(main % snippet) + +if __name__ == '__main__': + os.chdir(os.path.expanduser('~/.plt-scheme/4.0/collects')) + makedir('sweet-macros', snippet) + os.system('zip -r /tmp/sweet-macros-plt sweet-macros') + print 'Saved in /tmp/sweet-macros-plt' diff --git a/scheme/sweet-macros.sls b/scheme/sweet-macros.sls index e98439a..bc90e70 100644 --- a/scheme/sweet-macros.sls +++ b/scheme/sweet-macros.sls @@ -7,7 +7,7 @@ (export syntax-match def-syntax syntax-expand local) (import (rnrs)) -;; helper macro 1 +;;LOCAL (define-syntax local (lambda (x) (syntax-case x (syntax-match) @@ -18,8 +18,9 @@ ((local (let-form name value) (l n v) ... expr) #'(let-form ((name value)) (local (l n v) ... expr)))) )) +;;END -;; helper macro 2 +;;GUARDED-SYNTAX-CASE (define-syntax guarded-syntax-case (let ((add-clause (lambda (clause acc) @@ -45,7 +46,9 @@ (((c ...) (fold-right add-clause '() #'(clause ...)))) #'(syntax-case y (literal ...) c ...))) )))) +;;END +;;SYNTAX-MATCH (define-syntax syntax-match (guarded-syntax-case () (sub local) ((self (local (let-form name value) ...) (literal ...) @@ -74,7 +77,9 @@ ((self x (literal ...) (sub patt skel . rest) ...) #'(guarded-syntax-case x (literal ...) (patt skel . rest) ...)) )) +;;END +;; DEF-SYNTAX (define-syntax def-syntax (syntax-match (extends local) (sub (def-syntax name (extends parent) @@ -89,9 +94,12 @@ (sub (def-syntax name transformer) #'(define-syntax name transformer)) )) +;;END +;;SYNTAX-EXPAND (def-syntax (syntax-expand (macro . args)) #'(syntax->datum ((macro <transformer>) #'(... (... (macro . args)))))) +;;END ) ;;; LEGALESE |