diff options
| author | Aaron Marks <nymacro@gmail.com> | 2020-01-03 23:29:15 +1000 |
|---|---|---|
| committer | Aaron Marks <nymacro@gmail.com> | 2020-01-03 23:29:15 +1000 |
| commit | 645e4775420c59bb10ef0693ed2631a8df8c0e29 (patch) | |
| tree | 3dc334bf2ce20ab242f8b003333c51c1342c79d2 | |
| parent | 6ec47dc1b57c1475ace9869efc1d23332da89e9b (diff) | |
| download | geiser-guile-645e4775420c59bb10ef0693ed2631a8df8c0e29.tar.gz geiser-guile-645e4775420c59bb10ef0693ed2631a8df8c0e29.tar.bz2 | |
Add rudimentary Chez support for macro expansion
| -rw-r--r-- | scheme/chez/geiser/geiser.ss | 18 | ||||
| -rw-r--r-- | 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 |