Add syntax-case based syntax-rules.

* module/mes/psyntax-1.mes (syntax-rules): New syntax transformer,
  based on syntax-case.
  (define-syntax-rule): New macro.
  (let-syntax): New macro, for syntax-case.
* tests/let-syntax.test: Switch to syntax-case.
* tests/psyntax.test: Add syntax-rules and syntax-rule test.

module/mes/psyntax-1.mes

@@ -35,3 +35,29 @@
          (syntax-object->datum
           (,transformer (cons ,macro-name args)))
          (current-module)))))
+
+(define-syntax syntax-rules
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (k ...) ((keyword . pattern) template) ...)
+       (syntax (lambda (x)
+                (syntax-case x (k ...)
+                  ((dummy . pattern) (syntax template))
+                  ...)))))))
+
+(define-macro (define-syntax-rule id-pattern . template)
+  `(define-syntax ,(car id-pattern)
+     (syntax-rules ()
+       ((,(car id-pattern) . ,(cdr id-pattern)) ,@template))))
+
+(define-macro (let-syntax bindings . rest)
+  `((lambda ()
+      ,@(map (lambda (binding)
+               `(define-macro ,(car binding)
+                  `(lambda args
+                     (eval
+                      (syntax-object->datum
+                       (,(cadr binding) (cons ',(car binding) args)))
+                      (current-module)))))
+             bindings)
+      ,@rest)))

tests/let-syntax.test

@@ -30,8 +30,9 @@ exit $?
 (mes-use-module (mes quasiquote))
 (mes-use-module (mes let))
 (mes-use-module (mes scm))
-(mes-use-module (mes syntax))
-(mes-use-module (mes let-syntax))
+(mes-use-module (mes psyntax-0))
+(mes-use-module (mes psyntax-pp))
+(mes-use-module (mes psyntax-1))
 (mes-use-module (mes test))
 
 (pass-if "first dummy" #t)

tests/psyntax.test

@@ -119,5 +119,25 @@ exit $?
        (list foo bar)))
    (list "bar" "foo")))
 
-(result 'report)
+(pass-if "define-syntax sr:when [syntax-rules]"
+  (sequal?
+   (let ()
+     (define-syntax sr:when
+       (syntax-rules ()
+         ((sc:when condition exp ...)
+          (if condition
+              (begin exp ...)))))
+     (let ()
+       (sr:when #t "if not now, then?")))
+   "if not now, then?"))
 
+(pass-if "define-syntax-rule"
+  (sequal?
+   (let ()
+     (define-syntax-rule (sre:when c e ...)
+       (if c (begin e ...)))
+     (let ()
+       (sre:when #t "if not now, then?")))
+   "if not now, then?"))
+
+(result 'report)