suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Added quasitemplate/debug to the library.

Browse Source
This commit is contained in:
Georges Dupéron 2016-02-29 20:26:17 +01:00
parent 9457f05599
commit 0a532aa96e
2 changed files with 34 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
graph-lib/graph/graph.lp2.rkt
View File

@ -353,7 +353,7 @@ The first step macro is defined as follows:
@chunk[<first-step> @chunk[<first-step>
(define-syntax/parse <signature> (define-syntax/parse <signature>
<define-ids/first-step> <define-ids/first-step>
(debug-template debug (template/debug debug
;; Can't use (let () …) because of TR bug #262 ;; Can't use (let () …) because of TR bug #262
;; https://github.com/racket/typed-racket/issues/262 ;; https://github.com/racket/typed-racket/issues/262
(begin (begin
@ -378,7 +378,7 @@ It will be called from the first step with the following syntax:
@chunk[<second-step> @chunk[<second-step>
(define-syntax/parse <signature-second-step> (define-syntax/parse <signature-second-step>
<define-ids/second-step> <define-ids/second-step>
(debug-template debug (template/debug debug
(begin (begin
(begin <define-mapping-function>) … (begin <define-mapping-function>) …

34
graph-lib/lib/low.rkt
View File

@ -310,7 +310,8 @@
stx-list stx-list
stx-e stx-e
stx-pair stx-pair
debug-template template/debug
quasitemplate/debug
;string-set! ;string-set!
;string-copy! ;string-copy!
;string-fill! ;string-fill!
@ -463,7 +464,7 @@
'((y z) . x))) '((y z) . x)))
(require syntax/parse/experimental/template) (require syntax/parse/experimental/template)
(define-syntax (debug-template stx) (define-syntax (template/debug stx)
(syntax-parse stx (syntax-parse stx
[(_ debug-attribute:id . rest) [(_ debug-attribute:id . rest)
#'((λ (x) #'((λ (x)
@ -472,6 +473,35 @@
x) x)
(template . rest))])) (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) (define-syntax (string-set! stx)
(raise-syntax-error 'string-set! "Do not mutate strings." stx)) (raise-syntax-error 'string-set! "Do not mutate strings." stx))
(define-syntax (string-copy! stx) (define-syntax (string-copy! stx)