Partially reverted previous commit.
This commit is contained in:
parent
29c90350b2
commit
5d2f8cc512
|
@ -1,3 +0,0 @@
|
|||
(module steal-box '#%kernel
|
||||
(define-values (bx) (box #f))
|
||||
(#%provide bx))
|
|
@ -1,59 +0,0 @@
|
|||
#lang racket
|
||||
|
||||
;; Manages to grasp the template-metafunction via (namespace-mapped-symbols)
|
||||
;; within the eval.
|
||||
(module extracted-template-metafunction racket/base
|
||||
(require (for-syntax syntax/parse/experimental/template)
|
||||
(for-syntax racket/base)
|
||||
(for-meta 2 racket/base)
|
||||
(for-meta 2 stxparse-info/parse/experimental/steal-box))
|
||||
(define-syntax (fu stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id-mf? id-mf-v)
|
||||
(let ()
|
||||
(eval #'(begin
|
||||
(require (for-syntax
|
||||
stxparse-info/parse/experimental/steal-box))
|
||||
(define-template-metafunction (mf stx)
|
||||
#'1)
|
||||
(define-syntax (extract stx)
|
||||
;; Use 3D syntax to return the value:
|
||||
(displayln (namespace-mapped-symbols))
|
||||
;(displayln (eval 'template-metafunction))
|
||||
(define ctor (namespace-variable-value
|
||||
(for/first ([sym (namespace-mapped-symbols)]
|
||||
#:when (regexp-match #rx"template-metafunction[0-9].*" (symbol->string sym)))
|
||||
sym)))
|
||||
(displayln (list ctor (ctor 5165163)))
|
||||
(displayln (template-metafunction? (syntax-local-value #'mf)))
|
||||
(set-box! bx template-metafunction?)
|
||||
#'(void)
|
||||
#;#`(values #,template-metafunction?
|
||||
#,template-metafunction-var))
|
||||
(extract))
|
||||
(module->namespace 'syntax/parse/experimental/template))
|
||||
#`(begin
|
||||
(define-for-syntax id-mf? 0)
|
||||
(define-for-syntax id-mf-v 1)))]))
|
||||
(fu out-id-mf? out-id-mf-v)
|
||||
(begin-for-syntax
|
||||
(define-for-syntax rsl bx))
|
||||
|
||||
#;(begin-for-syntax
|
||||
(define-syntax (br stx)
|
||||
(displayln rsl)
|
||||
#'(void))
|
||||
(br))
|
||||
#;(begin-for-syntax
|
||||
(begin-for-syntax
|
||||
(displayln rsl)))
|
||||
(provide (for-meta 2 rsl #;out-id-mf? #;out-id-mf-v)))
|
||||
|
||||
#;(require (rename-in (for-template 'extracted-template-metafunction)
|
||||
[out-id-mf? template-metafunction?]
|
||||
[out-id-mf-v template-metafunction-var]))
|
||||
(require (for-meta -2 'extracted-template-metafunction))
|
||||
(displayln rsl)
|
||||
|
||||
#;(provide template-metafunction?
|
||||
template-metafunction-var)
|
|
@ -1,25 +0,0 @@
|
|||
#lang racket
|
||||
|
||||
(require (for-syntax syntax/parse/experimental/template)
|
||||
(for-syntax racket/base)
|
||||
(for-meta 2 racket/base)
|
||||
(for-meta 2 stxparse-info/parse/experimental/steal-box))
|
||||
|
||||
(begin-for-syntax
|
||||
(eval #'(begin (define-syntax (e2 stx)
|
||||
#`(begin
|
||||
(module #,(cdr (syntax-e stx)) racket
|
||||
(provide (for-syntax e4a e4b))
|
||||
;(require syntax/parse/experimental/template)
|
||||
(define-for-syntax e4a #,template-metafunction?)
|
||||
(define-for-syntax e4b #,template-metafunction-var)
|
||||
(module* e5 racket/base
|
||||
(require (for-template (submod "..")))
|
||||
(provide e4a e4b)))))
|
||||
(e2 . e3))
|
||||
(module->namespace 'syntax/parse/experimental/template))
|
||||
(define e5a (dynamic-require '(submod 'e3 e5) 'e4a))
|
||||
(define e5b (dynamic-require '(submod 'e3 e5) 'e4b))
|
||||
(provide (rename-out [e5a template-metafunction?]
|
||||
[e5b template-metafunction-var])))
|
||||
|
|
@ -16,64 +16,6 @@
|
|||
??
|
||||
?@)
|
||||
|
||||
;; This is a bit ugly. Also, we can't extract the constructor for some reason
|
||||
;; (probably because it is a transformer binding, not a variable),
|
||||
;; so we require the original `define-template-metafunction` from
|
||||
;; syntax/parse/experimental/template to fulfill the defintition below.
|
||||
(require (only-in syntax/parse/experimental/template
|
||||
define-template-metafunction))
|
||||
(begin-for-syntax
|
||||
(require "steal-metafunction.rkt")
|
||||
(provide template-metafunction?
|
||||
template-metafunction-var))
|
||||
#;(begin
|
||||
(require (only-in syntax/parse/experimental/template
|
||||
define-template-metafunction))
|
||||
(begin-for-syntax
|
||||
(module extracted-template-metafunction racket/base
|
||||
(require syntax/parse/experimental/template
|
||||
(for-syntax racket/base))
|
||||
(define-values (template-metafunction?
|
||||
;template-metafunction
|
||||
template-metafunction-var)
|
||||
(eval #'(begin
|
||||
(define-syntax (extract stx)
|
||||
;; Use 3D syntax to return the value:
|
||||
#`(values #,template-metafunction?
|
||||
;; Doesn't work, probably because it's a macro:
|
||||
;#,template-metafunction
|
||||
#,template-metafunction-var))
|
||||
(extract))
|
||||
(module->namespace 'syntax/parse/experimental/template)))
|
||||
(provide template-metafunction?
|
||||
;template-metafunction
|
||||
template-metafunction-var))
|
||||
|
||||
(require 'extracted-template-metafunction)
|
||||
(provide template-metafunction?
|
||||
template-metafunction-var)
|
||||
|
||||
;; Tests:
|
||||
#;(begin
|
||||
(require rackunit)
|
||||
|
||||
(require 'extracted-template-metafunction)
|
||||
(require (for-meta 4 'extracted-template-metafunction))
|
||||
(check-equal? (format "~a" template-metafunction?)
|
||||
"#<procedure:template-metafunction?>")
|
||||
|
||||
(require (for-meta 1 racket/base))
|
||||
(require (for-meta 2 racket/base))
|
||||
(require (for-meta 3 racket/base))
|
||||
(require (for-meta 4 racket/base))
|
||||
(begin-for-syntax
|
||||
(begin-for-syntax
|
||||
(begin-for-syntax
|
||||
(begin-for-syntax
|
||||
(require rackunit)
|
||||
(check-equal? (format "~a" template-metafunction?)
|
||||
"#<procedure:template-metafunction?>"))))))))
|
||||
|
||||
#|
|
||||
To do:
|
||||
- improve error messages
|
||||
|
@ -244,7 +186,10 @@ instead of integers and integer vectors.
|
|||
;; ============================================================
|
||||
|
||||
|
||||
#;(define-syntax (define-template-metafunction stx)
|
||||
;; TODO: once PR https://github.com/racket/racket/pull/1591 is merged, use
|
||||
;; the exported prop:template-metafunction, template-metafunction? and
|
||||
;; template-metafunction-accessor.
|
||||
(define-syntax (define-template-metafunction stx)
|
||||
(syntax-case stx ()
|
||||
[(dsm (id arg ...) . body)
|
||||
#'(dsm id (lambda (arg ...) . body))]
|
||||
|
@ -256,9 +201,7 @@ instead of integers and integer vectors.
|
|||
(template-metafunction (quote-syntax internal-id)))))]))
|
||||
|
||||
(begin-for-syntax
|
||||
;; This struct is not declared here, but instead extracted from the official
|
||||
;; syntax/parse/experimental/template, at the top of this file.
|
||||
#;(struct template-metafunction (var)))
|
||||
(struct template-metafunction (var)))
|
||||
|
||||
;; ============================================================
|
||||
|
||||
|
|
|
@ -1,14 +0,0 @@
|
|||
#lang racket
|
||||
(require syntax/parse/experimental/template
|
||||
stxparse-info/parse/experimental/steal-metafunction2)
|
||||
(define-template-metafunction (mf stx)
|
||||
#'1)
|
||||
(provide mf)
|
||||
|
||||
(let ()
|
||||
(define-syntax (foo stx)
|
||||
(displayln
|
||||
(template-metafunction?
|
||||
(syntax-local-value #'mf)))
|
||||
#''ok)
|
||||
(foo))
|
|
@ -1,8 +1,6 @@
|
|||
#lang racket
|
||||
(require ;syntax/parse
|
||||
;syntax/parse/experimental/template
|
||||
stxparse-info/parse
|
||||
stxparse-info/parse/experimental/template)
|
||||
(require syntax/parse
|
||||
syntax/parse/experimental/template)
|
||||
(provide mf original-template)
|
||||
(define-template-metafunction (mf stx)
|
||||
#'ok-metafunction-official-1)
|
||||
|
|
|
@ -1,23 +1,16 @@
|
|||
#lang racket
|
||||
(require ;syntax/parse
|
||||
;syntax/parse/experimental/template
|
||||
stxparse-info/parse
|
||||
(require stxparse-info/parse
|
||||
stxparse-info/parse/experimental/template
|
||||
rackunit
|
||||
#;"test-compatibility1.rkt")
|
||||
(define-template-metafunction (mf stx)
|
||||
#'ok-metafunction-official-1)
|
||||
"test-compatibility1.rkt")
|
||||
|
||||
;; TODO: re-enable this, and do the test the other way round too
|
||||
;; (the official syntax/parse to from stxparse-info)
|
||||
#;(check-equal? (syntax-parse #'(1 (2 3))
|
||||
[(x {~optional y} ({~optional z} t))
|
||||
(list #;(syntax->datum
|
||||
(original-template (x (?? y no-y) (?? z no-z) t (mf))))
|
||||
(list (syntax->datum
|
||||
(original-template (x (?? y no-y) (?? z no-z) t (mf))))
|
||||
(syntax->datum
|
||||
(template (x (?? y no-y) (?? z no-z) t (mf)))))])
|
||||
'(#;(1 no-y 2 3 ok-metafunction-official-1)
|
||||
'((1 no-y 2 3 ok-metafunction-official-1)
|
||||
(1 no-y 2 3 ok-metafunction-official-1)))
|
||||
|
||||
(syntax-parse #'(1 (2 3))
|
||||
[(x {~optional y} ({~optional z} t))
|
||||
(syntax->datum
|
||||
(template (x (?? y no-y) (?? z no-z) t (mf))))])
|
Loading…
Reference in New Issue
Block a user