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

making the transformer slightly more robust, but it's still a bit unsatisfying

Browse Source
This commit is contained in:
Danny Yoo 2011-08-09 15:40:12 -04:00
parent 6c2b05e8cc
commit 5cb2bef63a
2 changed files with 31 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
examples/snip.rkt
View File

@ -222,12 +222,12 @@
0 0 14 3 20 #"dyoo/whalesong/image" 0 0 14 3 20 #"dyoo/whalesong/image"
0 0 22 3 2 #"))" 0 0 22 3 2 #"))"
0 0 4 29 1 #"\n" 0 0 4 29 1 #"\n"
0 0 4 29 1 #"\n" 0 0 24 29 1 #"\n"
0 0 22 3 1 #"(" 0 0 22 3 1 #"("
0 0 15 3 6 #"define" 0 0 15 3 6 #"define"
0 0 4 3 1 #" " 0 0 24 3 1 #" "
0 0 14 3 6 #"a-snip" 0 0 14 3 6 #"a-snip"
0 0 4 3 1 #" " 0 0 24 3 1 #" "
0 2 35 4 1 #"\0" 0 2 35 4 1 #"\0"
2 -1.0 -1.0 0.0 0.0 0 12 500 2 -1.0 -1.0 0.0 0.0 0 12 500
( (

48
expand-out-images.rkt
View File

@ -14,6 +14,7 @@
(provide expand-out-images) (provide expand-out-images)
(define my-image-url (make-parameter #f))
;; expand-out-images: syntax -> syntax ;; expand-out-images: syntax -> syntax
;; Takes programs and rips out their image snips in favor of calls to ;; Takes programs and rips out their image snips in favor of calls to
@ -24,29 +25,36 @@
;; We need to translate image snips in the expanded form so we can ;; We need to translate image snips in the expanded form so we can
;; fruitfully use compiler/zo-parse. ;; fruitfully use compiler/zo-parse.
(define rewritten (define rewritten
(kernel-syntax-case (syntax-disarm expanded code-insp) #f (parameterize
[(#%expression expr) ([my-image-url (car (generate-temporaries #'(image-url)))])
(quasisyntax/loc stx
(#%expression #,(on-expr #'expr)))] (kernel-syntax-case (syntax-disarm expanded code-insp) #f
[(#%expression expr)
[(module id name-id (#%plain-module-begin module-level-form ...)) (quasisyntax/loc stx
(quasisyntax/loc stx (#%expression #,(on-expr #'expr)))]
(module id name-id (#%plain-module-begin
(require (planet dyoo/whalesong/image)) [(module id name-id (#%plain-module-begin module-level-form ...))
#,@(map convert-images-to-resources (quasisyntax/loc stx
(syntax->list #'(module-level-form ...))))))] (module id name-id (#%plain-module-begin
[(begin top-level-form ...) ;; Kludge: I'm trying to get at the image-url
(quasisyntax/loc stx ;; function, but in a way that doesn't clash with the
(begin #,@(map convert-images-to-resources ;; user's existing program.
(syntax->list #'(top-level-form ...)))))] (require (rename-in (planet dyoo/whalesong/image)
[else [image-url #,(my-image-url)]))
(convert-images-to-resources expanded)]))
#,@(map convert-images-to-resources
(syntax->list #'(module-level-form ...))))))]
[(begin top-level-form ...)
(quasisyntax/loc stx
(begin #,@(map convert-images-to-resources
(syntax->list #'(top-level-form ...)))))]
[else
(convert-images-to-resources expanded)])))
rewritten) rewritten)
(define code-insp (current-code-inspector)) (define code-insp (current-code-inspector))
@ -162,7 +170,7 @@
(with-syntax ([image-uri (with-syntax ([image-uri
(image->uri (syntax-e datum-stx))]) (image->uri (syntax-e datum-stx))])
(quasisyntax/loc datum-stx (quasisyntax/loc datum-stx
(image-url image-uri)))] (#,(my-image-url) image-uri)))]
[else [else
(k datum-stx)])) (k datum-stx)]))