summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAaron Marks <nymacro@gmail.com>2020-01-03 23:29:15 +1000
committerAaron Marks <nymacro@gmail.com>2020-01-03 23:29:15 +1000
commit645e4775420c59bb10ef0693ed2631a8df8c0e29 (patch)
tree3dc334bf2ce20ab242f8b003333c51c1342c79d2
parent6ec47dc1b57c1475ace9869efc1d23332da89e9b (diff)
downloadgeiser-guile-645e4775420c59bb10ef0693ed2631a8df8c0e29.tar.gz
geiser-guile-645e4775420c59bb10ef0693ed2631a8df8c0e29.tar.bz2
Add rudimentary Chez support for macro expansion
-rw-r--r--scheme/chez/geiser/geiser.ss18
-rw-r--r--scheme/chez/geiser/test.ss33
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