Fellow Chickeneers,
find attached a patch which allows user code to hook into the quasiquote
code expander. "What good can come from that?" you might ask. Let me
elaborate! As you know, Chicken supports custom reader extensions via
set-read-syntax! and friends. This is all fine unless you try to add
custom read syntax for compound data structures. One example of those
are SRFI 10 reader constructors which are also supported by core
Chicken. Let me give you an example how they work:
#;1> (define-record point x y)
#;2> (define-reader-ctor 'point make-point)
#;3> '#,(point 10 20)
#<point>
#;4> (point-x #3)
10
#;5> (point-y #3)
20
That's pretty straight forward. Now try this:
#;6> `#,(point ,(+ 5 5) 20)
#<point>
#;7> (point-x #6)
(unquote (+ 5 5))
Oops, not quite what we'd expect! Now, this problem was also discovered
in 2004 by Bradd W. Szonye (see
http://srfi.schemers.org/srfi-10/post-mail-archive/msg00000.html), alas
it was in the post-finalization phase of SRFI 10 and unfortunatley it
doesn't seem like there was much interest in that anymore then. So I
went ahead and tried to come up with a solution for that problem. What I
think is needed for this to work is to be able to hook into the
quasiquote expander (as noted above). The result of that is the attached
patch. It allows us to do this:
#;8> (define-quasiquote-handler point? (lambda (r walk n p) (list (r
'make-point) (walk (point-x p) n) (walk (point-y p) n))))
#;9> `#,(point ,(+ 5 5) 20)
#<point>
#;10> (point-x #9)
10
I think this kind of mechanism is something we should have in order to
provide proper support for custom read syntax and to make SRFI 10 syntax
behave as expected. Let me know if you have any suggestions for
improving the API (not sure if quasiquote-handler is the best name for
this kind of thing) or implementation (I don't know whether we need to
pass the `n' argument to handlers or if we can hide it in a closure, for
example). Also I'm not sure about where to put the code (maybe
define-quasiquote-handler should not live in expand.scm).
Thanks!
Moritz
>From b4c197c93c94bbfbab781e81a058d5fc3ad90f0a Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <mor...@twoticketsplease.de>
Date: Thu, 21 Feb 2013 18:53:08 +0100
Subject: [PATCH] Make quasiquote extensible with custom handlers
This patch introduces the define-quasiquote-handler form which allows
hooking into the quasiquote walker, allowing custom reader extensions
for compound data literals (such as SRFI 10 reader constructors) to
properly support unquoting.
---
expand.scm | 29 +++++++++++++++++++++++++++--
tests/reader-tests.scm | 11 +++++++++++
2 files changed, 38 insertions(+), 2 deletions(-)
diff --git a/expand.scm b/expand.scm
index b278ec0..8677eff 100644
--- a/expand.scm
+++ b/expand.scm
@@ -35,7 +35,9 @@
macro-alias
check-for-multiple-bindings
d dd dm dx map-se
- lookup check-for-redef)
+ lookup check-for-redef
+ quasiquote-handler-ref
+ quasiquote-handlers)
(not inline ##sys#syntax-error-hook ##sys#compiler-syntax-hook
##sys#toplevel-definition-hook))
@@ -1241,6 +1243,26 @@
(car (cdr (cdr b))) ) )
bindings) ) ) ) ) ) ) ) )
+
+(define quasiquote-handlers
+ (list))
+
+(define (define-quasiquote-handler pred handler)
+ (set! quasiquote-handlers
+ (if handler
+ (cons (cons pred handler) quasiquote-handlers)
+ (let loop ((qh quasiquote-handlers))
+ (cond ((null? qh) '())
+ ((eq? (caar qh) pred) (loop (cdr qh)))
+ (else (cons (car qh) (loop (cdr qh)))))))))
+
+(define (quasiquote-handler-ref x)
+ (let loop ((qh quasiquote-handlers))
+ (and (pair? qh)
+ (if ((caar qh) x)
+ (cdar qh)
+ (loop (cdr qh))))))
+
(##sys#extend-macro-environment
'quasiquote
'()
@@ -1251,7 +1273,10 @@
(%unquote-splicing (r 'unquote-splicing)))
(define (walk x n) (simplify (walk1 x n)))
(define (walk1 x n)
- (cond ((vector? x)
+ (cond ((quasiquote-handler-ref x) =>
+ (lambda (handle)
+ (handle r walk n x)))
+ ((vector? x)
`(##sys#list->vector ,(walk (vector->list x) n)) )
((not (pair? x)) `(##core#quote ,x))
(else
diff --git a/tests/reader-tests.scm b/tests/reader-tests.scm
index 894e846..58ad4c5 100644
--- a/tests/reader-tests.scm
+++ b/tests/reader-tests.scm
@@ -23,3 +23,14 @@
(assert (string=? output "hi\nfoo\nbaz\nbye\n"))
(assert (string=? " ." (with-input-from-string "\x20\u0020\U00000020\056" read-all)))
+
+
+(define-record foo bar)
+(define-reader-ctor 'foo make-foo)
+(define-quasiquote-handler foo?
+ (lambda (rename walk n x)
+ (list (rename 'make-foo)
+ (walk (foo-bar x) n))))
+
+(assert (= 1 (foo-bar '#,(foo 1))))
+(assert (= 3 (foo-bar `#,(foo ,(+ 1 2)))))
--
1.8.1.4
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
