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")
(define name "Web Server")
; XXX Uncomment and change doc-installer
#;(define post-install-collection "docs/doc-installer.ss")
; Name clash
#;(define scribblings '(("docs/reference/reference.scrbl" (multi-page main-doc))))
(define mzscheme-launcher-libraries
(list "private/launch-text.ss"))

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

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

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

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

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

@ -88,8 +88,8 @@
the-save-cm-key
(#%app current-saved-continuation-marks-and #,ke-prime #,me-prime)
#,be-prime)))))]
[(#%expression . d)
stx]
[(#%expression d)
(markit (quasisyntax/loc stx (#%expression #,(elim-callcc #'d))))]
[(#%app call/cc w)
(let-values ([(cm ref-to-cm) (generate-formal 'current-marks)]
[(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)])
(syntax/loc stx
(with-continuation-mark ke me be)))]
[(#%expression . d)
stx]
[(#%expression d)
(quasisyntax/loc stx (#%expression #,((elim-letrec ids) #'d)))]
[(#%app e ...)
(with-syntax ([(e ...) (map (elim-letrec ids) (syntax->list #'(e ...)))])
(syntax/loc stx

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

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