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

Added uses of internal-definition-context-apply from unstable/syntax

Browse Source
This commit is contained in:
Ryan Culpepper 2010-07-01 21:29:42 -06:00
parent 07f57aac9b
commit 79a06deb79
4 changed files with 10 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mzlib/private/sigutil.rkt
View File

@ -602,6 +602,7 @@
(syntax-e (stx-car (stx-cdr p)))))
(cdr (stx->list
(let ([rn (car body)])
;; Use internal-definition-context-apply ??
(local-expand rn
'expression
(list (stx-car rn))

8
collects/mzlib/unit200.rkt
View File

@ -6,6 +6,7 @@
syntax/stx
syntax/name
syntax/context
unstable/syntax
"list.rkt"
"private/unitidmap.rkt")
@ -73,11 +74,8 @@
(begin
;; Treat imports as internal-defn names:
(syntax-local-bind-syntaxes ids #f def-ctx)
(cdr (syntax->list
(local-expand #`(stop #,@ids)
'expression
(list #'stop)
def-ctx))))
(syntax->list
(internal-definition-context-apply def-ctx ids)))
ids)
;; Let later checking report an error:
ids))])

11
collects/racket/contract/regions.rkt
View File

@ -562,9 +562,7 @@
(values (syntax->list #'(fv.var ...))
(syntax->list #'(fv.ctc ...)))])
(define (add-context stx)
(let ([ctx-added-stx (local-expand #`(quote #,stx) ctx (list #'quote) intdef)])
(syntax-case ctx-added-stx ()
[(_ expr) #'expr])))
(internal-definition-context-apply intdef stx))
(syntax-local-bind-syntaxes free-vars #f intdef)
(internal-definition-context-seal intdef)
(with-syntax ([blame-stx #''(region blame)]
@ -621,12 +619,7 @@
(values (syntax->list #'(ec.var ...))
(syntax->list #'(ec.ctc ...)))])
(define (add-context stx)
(let ([ctx-added-stx (local-expand #`(quote #,stx)
ctx
(list #'quote)
intdef)])
(syntax-case ctx-added-stx ()
[(_ expr) #'expr])))
(internal-definition-context-apply intdef stx))
(syntax-local-bind-syntaxes protected #f intdef)
(syntax-local-bind-syntaxes free-vars #f intdef)
(internal-definition-context-seal intdef)

17
collects/racket/splicing.rkt
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require (for-syntax scheme/base
syntax/kerncase)
syntax/kerncase
unstable/syntax)
"stxparam.rkt"
"private/stxparam.rkt"
"private/local.rkt")
@ -56,12 +57,7 @@
(internal-definition-context-seal def-ctx)
(let* ([add-context
(lambda (expr)
(let ([q (local-expand #`(quote #,expr)
ctx
(list #'quote)
def-ctx)])
(syntax-case q ()
[(_ expr) #'expr])))])
(internal-definition-context-apply def-ctx expr))])
(with-syntax ([((id ...) ...)
(map (lambda (ids)
(map add-context ids))
@ -129,12 +125,7 @@
(internal-definition-context-seal def-ctx)
(let* ([add-context
(lambda (expr)
(let ([q (local-expand #`(quote #,expr)
ctx
(list #'quote)
def-ctx)])
(syntax-case q ()
[(_ expr) #'expr])))]
(internal-definition-context-apply def-ctx expr))]
[add-context-to-idss
(lambda (idss)
(map add-context idss))])