From 0a532aa96ee7bb3616f3fff117660e24e8006492 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Mon, 29 Feb 2016 20:26:17 +0100
Subject: [PATCH] Added quasitemplate/debug to the library.

---
 graph-lib/graph/graph.lp2.rkt |  4 ++--
 graph-lib/lib/low.rkt         | 34 ++++++++++++++++++++++++++++++++--
 2 files changed, 34 insertions(+), 4 deletions(-)

diff --git a/graph-lib/graph/graph.lp2.rkt b/graph-lib/graph/graph.lp2.rkt
index 42019bb6..0223ff7e 100644
--- a/graph-lib/graph/graph.lp2.rkt
+++ b/graph-lib/graph/graph.lp2.rkt
@@ -353,7 +353,7 @@ The first step macro is defined as follows:
 @chunk[<first-step>
        (define-syntax/parse <signature>
          <define-ids/first-step>
-         (debug-template debug
+         (template/debug debug
            ;; Can't use (let () …) because of TR bug #262
            ;; https://github.com/racket/typed-racket/issues/262
            (begin
@@ -378,7 +378,7 @@ It will be called from the first step with the following syntax:
 @chunk[<second-step>
        (define-syntax/parse <signature-second-step>
          <define-ids/second-step>
-         (debug-template debug
+         (template/debug debug
           (begin
             (begin <define-mapping-function>) …
             
diff --git a/graph-lib/lib/low.rkt b/graph-lib/lib/low.rkt
index 52bf6a60..56cbf14f 100644
--- a/graph-lib/lib/low.rkt
+++ b/graph-lib/lib/low.rkt
@@ -310,7 +310,8 @@
          stx-list
          stx-e
          stx-pair
-         debug-template
+         template/debug
+         quasitemplate/debug
          ;string-set!
          ;string-copy!
          ;string-fill!
@@ -463,7 +464,7 @@
                 '((y z) . x)))
 
 (require syntax/parse/experimental/template)
-(define-syntax (debug-template stx)
+(define-syntax (template/debug stx)
   (syntax-parse stx
     [(_ debug-attribute:id . rest)
      #'((λ (x)
@@ -472,6 +473,35 @@
           x)
         (template . rest))]))
 
+(define-syntax (quasitemplate/debug stx)
+  (syntax-parse stx
+    [(_ debug-attribute:id . rest)
+     #'((λ (x)
+          (when (attribute debug-attribute)
+            (pretty-write (syntax->datum x)))
+          x)
+        (quasitemplate . rest))]))
+
+;; TODO: this is kind of a hack, as we have to write:
+#;(with-syntax ([(x …) #'(a bb ccc)])
+    (let ([y 70])
+      (quasitemplate
+       ([x (meta-eval (+ #,y (string-length
+                              (symbol->string
+                               (syntax-e #'x)))))]
+        …))))
+;; Where we need #,y instead of using:
+;; (+ y (string-length etc.)).
+(module m-meta-eval racket
+  (provide meta-eval)
+  (require syntax/parse/experimental/template)
+  
+  (define-template-metafunction (meta-eval stx)
+    (syntax-case stx ()
+      [(_ . body)
+       #`#,(eval #'(begin . body))])))
+(require/provide 'm-meta-eval)
+
 (define-syntax (string-set! stx)
   (raise-syntax-error 'string-set! "Do not mutate strings." stx))
 (define-syntax (string-copy! stx)