summaryrefslogtreecommitdiff
path: root/scheme
diff options
context:
space:
mode:
authormichele.simionato <devnull@localhost>2009-02-18 07:10:40 +0000
committermichele.simionato <devnull@localhost>2009-02-18 07:10:40 +0000
commit4deb0f5e4b702f7eceb3f45ef0c8a0ad468463ed (patch)
tree9c97225ee83bbfccc21ac90e3d5b467196458891 /scheme
parent607990edc91614f39071c47f439aeb1d7fb30c01 (diff)
downloadmicheles-4deb0f5e4b702f7eceb3f45ef0c8a0ad468463ed.tar.gz
Added a script to generate the sweet-macros package for PLT Scheme from the Ikarus source
Diffstat (limited to 'scheme')
-rw-r--r--scheme/sweet-macros.sls12
1 files changed, 10 insertions, 2 deletions
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