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 22 3 2 #"))"
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 15 3 6 #"define"
0 0 4 3 1 #" "
0 0 24 3 1 #" "
0 0 14 3 6 #"a-snip"
0 0 4 3 1 #" "
0 0 24 3 1 #" "
0 2 35 4 1 #"\0"
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)
(define my-image-url (make-parameter #f))
;; expand-out-images: syntax -> syntax
;; 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
;; fruitfully use compiler/zo-parse.
(define rewritten
(kernel-syntax-case (syntax-disarm expanded code-insp) #f
[(#%expression expr)
(quasisyntax/loc stx
(#%expression #,(on-expr #'expr)))]
[(module id name-id (#%plain-module-begin module-level-form ...))
(quasisyntax/loc stx
(module id name-id (#%plain-module-begin
(require (planet dyoo/whalesong/image))
#,@(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)]))
(parameterize
([my-image-url (car (generate-temporaries #'(image-url)))])
(kernel-syntax-case (syntax-disarm expanded code-insp) #f
[(#%expression expr)
(quasisyntax/loc stx
(#%expression #,(on-expr #'expr)))]
[(module id name-id (#%plain-module-begin module-level-form ...))
(quasisyntax/loc stx
(module id name-id (#%plain-module-begin
;; Kludge: I'm trying to get at the image-url
;; function, but in a way that doesn't clash with the
;; user's existing program.
(require (rename-in (planet dyoo/whalesong/image)
[image-url #,(my-image-url)]))
#,@(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)
(define code-insp (current-code-inspector))
@ -162,7 +170,7 @@
(with-syntax ([image-uri
(image->uri (syntax-e datum-stx))])
(quasisyntax/loc datum-stx
(image-url image-uri)))]
(#,(my-image-url) image-uri)))]
[else
(k datum-stx)]))