[nongnu] elpa/geiser-chez a0f6fc3 15/37: Add rudimentary Chez support for macro expansion

[Philip Kaludercic]

branch: elpa/geiser-chez
commit a0f6fc32a81267154ed71f8668a1ecd227e7b37b
Author: Aaron Marks <nymacro@gmail.com>
Commit: Aaron Marks <nymacro@gmail.com>

    Add rudimentary Chez support for macro expansion
---
 scheme/chez/geiser/geiser.ss | 18 +++++++++++-------
 scheme/chez/geiser/test.ss   | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 43 insertions(+), 8 deletions(-)

diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss
index 70b6b67..5c92a5b 100644
--- a/scheme/chez/geiser/geiser.ss
+++ b/scheme/chez/geiser/geiser.ss
@@ -5,7 +5,8 @@
           geiser:autodoc
           geiser:no-values
          geiser:load-file
-          geiser:newline)
+          geiser:newline
+          geiser:macroexpand)
   (import (chezscheme))
 
   (define (last-index-of str-list char idx last-idx)
@@ -56,8 +57,8 @@
                 (k `((result "")
                      (output . ,(get-output-string output-string))
                      (error (key . ,(with-output-to-string
-                                     (lambda ()
-                                       (display-condition e))))))))
+                                      (lambda ()
+                                        (display-condition e))))))))
             (lambda ()
               (call-with-values
                   ;; evaluate form, allow for multiple return values,
@@ -69,9 +70,9 @@
                           (eval form))))
                 (lambda result
                   `((result ,(with-output-to-string
-                              (lambda ()
-                                (pretty-print
-                                 (if (null? (cdr result)) (car result) 
result)))))
+                               (lambda ()
+                                 (pretty-print
+                                  (if (null? (cdr result)) (car result) 
result)))))
                     (output . ,(get-output-string output-string))))))))))
       (newline)
       (close-output-port output-string)))
@@ -145,4 +146,7 @@
     #f)
 
   (define (geiser:newline)
-    #f))
+    #f)
+
+  (define (geiser:macroexpand form . rest)
+    (syntax->datum (expand form))))
diff --git a/scheme/chez/geiser/test.ss b/scheme/chez/geiser/test.ss
index ac5503b..21f3396 100644
--- a/scheme/chez/geiser/test.ss
+++ b/scheme/chez/geiser/test.ss
@@ -1,13 +1,21 @@
 (import (geiser)
        (chezscheme))
 
+(define-syntax assert-equal
+  (syntax-rules ()
+    ((_ a b)
+     (if (equal? a b)
+         #t
+         (begin
+           (display (format "failed assertion `~a' == `~a'" a b))
+           (assert (equal? a b)))))))
 
 (define-syntax get-result
   (syntax-rules ()
     ((_ form)
      (with-output-to-string
        (lambda ()
-        (geiser:eval #f form))))))
+         (geiser:eval #f form))))))
 
 (define-syntax do-test
   (syntax-rules ()
@@ -17,6 +25,29 @@
        (get-result form)
        result)))))
 
+(define-syntax do-test-macroexpand
+  (syntax-rules ()
+    ((_ form result)
+     (assert
+      (equal? (geiser:macroexpand form)
+              result)))))
+
+(define-syntax test-or
+  (syntax-rules ()
+    ((_ x) x)
+    ((_ x xs ...)
+     (if x
+         x
+         (test-or xs ...)))))
+
+(do-test-macroexpand
+ '(test-or 1)
+ '1)
+
+(do-test-macroexpand
+ '(test-or 1 2)
+ '(if 1 1 2))
+
 ;; (something-doesnot-exist)
 ;;=> Error: Exception: variable something-doesnot-exist is not bound
 (do-test