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

Bug in handling of expression syntax

Browse Source 
svn: r7452
This commit is contained in:
Jay McCarthy 2007-10-08 14:59:27 +00:00
parent c8aa5fdd82
commit cb5c9f2ba6
6 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/web-server/info.ss
View File

@ -1,7 +1,7 @@
(module info (lib "infotab.ss" "setup") (module info (lib "infotab.ss" "setup")
(define name "Web Server") (define name "Web Server")
; XXX Uncomment and change doc-installer ; Name clash
#;(define post-install-collection "docs/doc-installer.ss") #;(define scribblings '(("docs/reference/reference.scrbl" (multi-page main-doc))))
(define mzscheme-launcher-libraries (define mzscheme-launcher-libraries
(list "private/launch-text.ss")) (list "private/launch-text.ss"))

8
collects/web-server/lang/anormal.ss
View File

@ -140,8 +140,12 @@
#,(anormal-term #'be)))) #,(anormal-term #'be))))
#'me))) #'me)))
#'ke)] #'ke)]
[(#%expression . d) [(#%expression d)
(ctxt stx)] (anormal
(compose ctxt
(lambda (d)
(quasisyntax/loc stx (#%expression #,d))))
#'d)]
[(#%app fe e ...) [(#%app fe e ...)
(anormal (anormal
(lambda (val0) (lambda (val0)

7
collects/web-server/lang/defun.ss
View File

@ -112,9 +112,10 @@
(let-values ([(es defs) (defun* (list #'ke #'me #'be))]) (let-values ([(es defs) (defun* (list #'ke #'me #'be))])
(values (quasisyntax/loc stx (with-continuation-mark #,@es)) (values (quasisyntax/loc stx (with-continuation-mark #,@es))
defs))] defs))]
[(#%expression . d) [(#%expression d)
(values stx (let-values ([(nd d-defs) (defun #'d)])
empty)] (values (quasisyntax/loc stx (#%expression #,nd))
d-defs))]
[(#%app e ...) [(#%app e ...)
(let-values ([(es defs) (defun* (syntax->list #'(e ...)))]) (let-values ([(es defs) (defun* (syntax->list #'(e ...)))])
(values (quasisyntax/loc stx (#%app #,@es)) (values (quasisyntax/loc stx (#%app #,@es))

4
collects/web-server/lang/elim-callcc.ss
View File

@ -88,8 +88,8 @@
the-save-cm-key the-save-cm-key
(#%app current-saved-continuation-marks-and #,ke-prime #,me-prime) (#%app current-saved-continuation-marks-and #,ke-prime #,me-prime)
#,be-prime)))))] #,be-prime)))))]
[(#%expression . d) [(#%expression d)
stx] (markit (quasisyntax/loc stx (#%expression #,(elim-callcc #'d))))]
[(#%app call/cc w) [(#%app call/cc w)
(let-values ([(cm ref-to-cm) (generate-formal 'current-marks)] (let-values ([(cm ref-to-cm) (generate-formal 'current-marks)]
[(x ref-to-x) (generate-formal 'x)]) [(x ref-to-x) (generate-formal 'x)])

4
collects/web-server/lang/elim-letrec.ss
View File

@ -114,8 +114,8 @@
[be ((elim-letrec ids) #'be)]) [be ((elim-letrec ids) #'be)])
(syntax/loc stx (syntax/loc stx
(with-continuation-mark ke me be)))] (with-continuation-mark ke me be)))]
[(#%expression . d) [(#%expression d)
stx] (quasisyntax/loc stx (#%expression #,((elim-letrec ids) #'d)))]
[(#%app e ...) [(#%app e ...)
(with-syntax ([(e ...) (map (elim-letrec ids) (syntax->list #'(e ...)))]) (with-syntax ([(e ...) (map (elim-letrec ids) (syntax->list #'(e ...)))])
(syntax/loc stx (syntax/loc stx

6
collects/web-server/lang/freevars.ss
View File

@ -67,11 +67,12 @@
(apply append (map syntax->list (syntax->list #'((vv ...) ...))))))] (apply append (map syntax->list (syntax->list #'((vv ...) ...))))))]
[(with-continuation-mark ke me be) [(with-continuation-mark ke me be)
(free-vars* (syntax->list #'(ke me be)))] (free-vars* (syntax->list #'(ke me be)))]
[(#%expression . d) [(#%expression d)
empty] (free-vars #'d)]
[(#%app e ...) [(#%app e ...)
(free-vars* (syntax->list #'(e ...)))] (free-vars* (syntax->list #'(e ...)))]
[(#%top . v) [(#%top . v)
#;(printf "Not including top ~S in freevars~n" (syntax-object->datum #'v))
empty] empty]
[(#%datum . d) [(#%datum . d)
empty] empty]
@ -81,6 +82,7 @@
[(eqv? 'lexical (identifier-binding #'id)) [(eqv? 'lexical (identifier-binding #'id))
(list #'id)] (list #'id)]
[else [else
#;(printf "Not including var-reference ~S with binding ~S in freevars~n" (syntax-object->datum #'id) i-bdg)
empty]))] empty]))]
[id (identifier? #'id) [id (identifier? #'id)
(let ([i-bdg (identifier-binding #'id)]) (let ([i-bdg (identifier-binding #'id)])