diff --git a/collects/scheme/private/at-syntax.ss b/collects/scheme/private/at-syntax.ss deleted file mode 100644 index e6130c473e..0000000000 --- a/collects/scheme/private/at-syntax.ss +++ /dev/null @@ -1,71 +0,0 @@ -#lang scheme/base - -(require (for-template scheme/base)) - -(provide at-syntax) - -;; ------------------------------------------------------------------- -;; NOTE: This library is for internal use only, it is can change -;; and/or disappear. Do not use without protective eyewear! -;; ------------------------------------------------------------------- - -#| - -The `(at-syntax expr)' form is a useful syntax-time utility that can -be used to sort of evaluate an expression at syntax time, and doing so -in a well behaved way (eg, it respects the source for-syntax bindings, -but it does have some issues). It can be used to implement an escape -to the syntax level that is not restricted like `begin-for-syntax'. - -The basic idea of the code is to plant the given expression on the -right hand side of a `let-syntax' -- inside a `(lambda (stx) ...)' to -make it a valid transformer, with a singe use of this macro so that we -get it to execute with `local-expand'. The macro returns a 3d -expression that contains the evaluated expression "somehwhere", -depending on the expansion of `let-syntax' -- so to make it easy to -find we plant it inside a thunk (so this works as long as `let-syntax' -does not include 3d procedure values in its expansion). Finally, the -constructed `let-syntax' is expanded, we search through the resulting -syntax for the thunk, then apply it to get the desired value. - -Here's a silly example to demonstrate: - - > (define-syntax (compile-time-if stx) - (syntax-case stx () - [(_ cond expr1 expr2) - (if (at-syntax #'cond) #'expr1 #'expr2)])) - > (define-for-syntax x 8) - > (define x 100) - > (compile-time-if (< x 10) (+ x 10) (- x 10)) - 110 - -And another example, creating a macro for syntax-time expressions: - - > (define-syntax (compile-time-value stx) - (syntax-case stx () - [(_ expr) #`(quote #,(at-syntax #'expr))])) - > (compile-time-value (* x 2)) - 16 - -but the `quote' here is a hint that this can get 3d values into -syntax, and all the problems that are involved. Also, note that it -even works if you try to do something like: - - > (compile-time-value (begin (set! x 11) x)) - 11 - -(but, of course, it cannot be used to define new bindings). - -|# - -(define (at-syntax expr) - (let loop ([x (with-syntax ([e expr]) - (local-expand - #'(let-syntax ([here (lambda (stx) - (datum->syntax stx (lambda () e)))]) - here) - 'expression '()))]) - (cond [(procedure? x) (x)] - [(pair? x) (or (loop (car x)) (loop (cdr x)))] - [(syntax? x) (loop (syntax-e x))] - [else #f]))) diff --git a/collects/scheme/provide.ss b/collects/scheme/provide.ss index 9c4cd9b446..b3bdbd12f1 100644 --- a/collects/scheme/provide.ss +++ b/collects/scheme/provide.ss @@ -1,7 +1,7 @@ #lang scheme/base (require (for-syntax scheme/base scheme/provide-transform scheme/list - "private/at-syntax.ss")) + (only-in unstable/syntax syntax-local-eval))) (provide matching-identifiers-out) (define-syntax matching-identifiers-out @@ -21,7 +21,7 @@ (lambda (stx modes) (syntax-case stx () [(_ proc spec) - (let ([proc (at-syntax #'proc)]) + (let ([proc (syntax-local-eval #'proc)]) (filter-map (lambda (e) (let* ([s1 (symbol->string (export-out-sym e))] diff --git a/collects/scheme/require.ss b/collects/scheme/require.ss index 0349b3df30..b40197f910 100644 --- a/collects/scheme/require.ss +++ b/collects/scheme/require.ss @@ -1,7 +1,7 @@ #lang scheme/base (require (for-syntax scheme/base scheme/require-transform scheme/list - "private/at-syntax.ss") + (only-in unstable/syntax syntax-local-eval)) "require-syntax.ss") (provide matching-identifiers-in) @@ -43,7 +43,7 @@ (lambda (stx) (syntax-case stx () [(_ proc spec) - (let ([proc (at-syntax #'proc)]) + (let ([proc (syntax-local-eval #'proc)]) (define-values [imports sources] (expand-import #'spec)) (values (filter-map diff --git a/collects/unstable/syntax.ss b/collects/unstable/syntax.ss index 9397876fd8..0ad94ddeb0 100644 --- a/collects/unstable/syntax.ss +++ b/collects/unstable/syntax.ss @@ -4,7 +4,8 @@ syntax/stx unstable/struct (for-syntax scheme/base - scheme/private/sc)) + scheme/private/sc) + (for-template scheme/base)) (provide unwrap-syntax