suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

While trying to remove the use-scope which causes problem with my implementation of #, in chunks. Found the solution: syntax-local-identifier-as-binding

Browse Source
This commit is contained in:
Georges Dupéron 2016-08-01 17:27:18 +02:00
parent 213253f531
commit d62546af81
2 changed files with 95 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
private/common.rkt
View File

@ -132,13 +132,13 @@
(syntax-case exprs ()
[() (void)]
[(expr . exprs)
(syntax-case #'expr (define-syntax quote-syntax)
(syntax-case #'expr (define-values quote-syntax)
[(define-values (lifted) (quote-syntax (a-chunk id body ...)))
(eq? (syntax-e #'a-chunk) 'a-chunk)
(begin
(add-to-chunk! #'id (syntax->list #'(body ...)))
(loop #'exprs))]
[_
[_
(loop #'exprs)])])))
(require (for-syntax racket/syntax
@ -204,11 +204,11 @@
;; and make these identifiers exported by
;; hyper-literate
(strip-context
#'((define-syntax-rule (if-preexpanding a b)
#'(#;(define-syntax-rule (if-preexpanding a b)
b)
(define-syntax-rule (when-preexpanding . b)
#;(define-syntax-rule (when-preexpanding . b)
(begin))
(define-syntax-rule
#;(define-syntax-rule
(unless-preexpanding . b)
(begin . b))
(require scribble/manual

97
private/lp.rkt
View File

@ -14,11 +14,13 @@
(define (get-chunk-number id)
(free-identifier-mapping-get chunk-numbers id (lambda () #f)))
(define (inc-chunk-number id)
(free-identifier-mapping-put! chunk-numbers id (+ 1 (free-identifier-mapping-get chunk-numbers id))))
(free-identifier-mapping-put!
chunk-numbers id
(+ 1 (free-identifier-mapping-get chunk-numbers id))))
(define (init-chunk-number id)
(free-identifier-mapping-put! chunk-numbers id 2)))
(define-for-syntax ((make-chunk racketblock) stx)
(define-for-syntax ((make-chunk racketblock unsyntax?) stx)
(syntax-parse stx
[(_ (~optional (~seq #:save-as save-as)) name expr ...)
;; no need for more error checking, using chunk for the code will do that
@ -29,9 +31,90 @@
(when n
(inc-chunk-number (syntax-local-introduce #'name)))
;; Lift the code so that it is caught by `extract-chunks` in common.rkt
;(syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...)))
(syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...)))
;; Convoluted trick to allow unsyntax in chunks of code. The unsyntax
;; escapes the chunk so that code can be injected at compile-time.
;; The identifiers inside the escaped portion need to be available both
;; for-syntax i.e. (for-meta 1) and (for-meta 0). This is because the
;; underlying @racketblock expands the code at run-time, but the
;; extract-chunks function in common.rkt looks at the expanded source
;; code.
;; For now, only #, i.e. unsyntax is supported, within @chunk.
;; Later support for UNSYNTAX within @CHUNK may be added.
(if unsyntax?
;; New hack:
(let ()
(display (syntax->datum #'name))
(display " 1 ")
(displayln (hash-ref (syntax-debug-info #'name) 'context))
#;(syntax-local-lift-expression
#'(quote-syntax (a-chunk name (expr ...))))
(syntax-local-lift-module-end-declaration
#'(begin
(require macro-debugger/syntax-browser)
(define-syntax (step3 stx22)
(syntax-case stx22 ()
[(_ aaa bbb xxx)
(let ()
(define +aaa (make-syntax-delta-introducer #'aaa (datum->syntax #f 'none)))
(define +bbb (make-syntax-delta-introducer (syntax-local-identifier-as-binding #'bbb) (datum->syntax #f 'none)))
(define aaa-bbb (+bbb (+aaa (datum->syntax #f 'none) 'add) 'remove))
(define bbb-aaa (+aaa (+bbb (datum->syntax #f 'none) 'add) 'remove))
(define +_aaa-bbb (make-syntax-delta-introducer aaa-bbb (datum->syntax #f 'none)))
(define +_bbb-aaa (make-syntax-delta-introducer aaa-bbb (datum->syntax #f 'none)))
(newline)
(display "aaaU ") (displayln (hash-ref (syntax-debug-info (syntax-local-identifier-as-binding #'aaa)) 'context))
(display "bbb ") (displayln (hash-ref (syntax-debug-info #'bbb) 'context))
(display "+aaa ") (displayln (hash-ref (syntax-debug-info (+aaa (datum->syntax #f 'none) 'add)) 'context))
(display "+bbb ") (displayln (hash-ref (syntax-debug-info (+bbb (datum->syntax #f 'none) 'add)) 'context))
(display "aaa-bbb ") (displayln (hash-ref (syntax-debug-info aaa-bbb) 'context))
(display "bbb-aaa ") (displayln (hash-ref (syntax-debug-info bbb-aaa) 'context))
(syntax-local-lift-expression (+_aaa-bbb #'xxx 'remove))
#'(void))]))
(define-syntax (fo _)
(define a #'here)
(define b (syntax-local-introduce #'here))
(define intr (make-syntax-delta-introducer b a))
(display (syntax->datum #'name))
(display " 2 ")
(displayln (hash-ref (syntax-debug-info #'name) 'context))
(display "a2 ")
(displayln (hash-ref (syntax-debug-info a) 'context))
(display "b2 ")
(displayln (hash-ref (syntax-debug-info b) 'context))
(display "i2 ")
(displayln (hash-ref (syntax-debug-info (intr (datum->syntax #f 'xxx) 'add)) 'context))
#;(syntax-local-lift-expression
#`(quote-syntax (a-chunk xyz
(begin
(displayln "hi")
(require macro-debugger/syntax-browser)
(browse-syntax (quote-syntax (a-chunk name expr ...)))))))
#;(syntax-local-lift-expression
#`(quote-syntax (a-chunk name
;#,(hash-ref (syntax-debug-info a) 'context)
;#,(hash-ref (syntax-debug-info b) 'context)
expr ...)))
#;#'(begin)
#`(step3 #,a
#,b
(quote-syntax (a-chunk name
;#,(hash-ref (syntax-debug-info a) 'context)
;#,(hash-ref (syntax-debug-info b) 'context)
expr ...))))
(fo))));(quote-syntax (a-chunk name expr ...)))
;; Default (old) behaviour, which does not support escaping (via #,):
(syntax-local-lift-expression
#'(quote-syntax (a-chunk name (expr ...)))))
;; Extract require forms
(with-syntax ([tag tag]
[str str]
[((for-label-mod ...) ...)
@ -43,7 +126,7 @@
[(null? mods) null]
[else
(syntax-case (car mods)
(for-syntax quote submod)
(for-syntax quote submod)
[(submod ".." . _)
(loop (cdr mods))]
[(submod "." . _)
@ -82,8 +165,8 @@
#'(define-syntax (save-as s) (syntax pre-content))
#'pre-content))))]))
(define-syntax chunk (make-chunk #'racketblock))
(define-syntax CHUNK (make-chunk #'RACKETBLOCK))
(define-syntax chunk (make-chunk #'racketblock #t))
(define-syntax CHUNK (make-chunk #'RACKETBLOCK #f))
(define-syntax (chunkref stx)
(syntax-case stx ()