From 5d2f8cc5127cabef234ee3875c60bf589ada0dc4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 25 Jan 2017 01:33:15 +0100 Subject: [PATCH] Partially reverted previous commit. --- parse/experimental/steal-box.rkt | 3 - parse/experimental/steal-metafunction.rkt | 59 ------------------- parse/experimental/steal-metafunction2.rkt | 25 -------- parse/experimental/template.rkt | 67 ++-------------------- parse/experimental/test-steal.rkt | 14 ----- test/test-compatibility1.rkt | 6 +- test/test-compatibility2.rkt | 21 +++---- 7 files changed, 14 insertions(+), 181 deletions(-) delete mode 100644 parse/experimental/steal-box.rkt delete mode 100644 parse/experimental/steal-metafunction.rkt delete mode 100644 parse/experimental/steal-metafunction2.rkt delete mode 100644 parse/experimental/test-steal.rkt diff --git a/parse/experimental/steal-box.rkt b/parse/experimental/steal-box.rkt deleted file mode 100644 index a077315..0000000 --- a/parse/experimental/steal-box.rkt +++ /dev/null @@ -1,3 +0,0 @@ -(module steal-box '#%kernel - (define-values (bx) (box #f)) - (#%provide bx)) \ No newline at end of file diff --git a/parse/experimental/steal-metafunction.rkt b/parse/experimental/steal-metafunction.rkt deleted file mode 100644 index 52a59d8..0000000 --- a/parse/experimental/steal-metafunction.rkt +++ /dev/null @@ -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) diff --git a/parse/experimental/steal-metafunction2.rkt b/parse/experimental/steal-metafunction2.rkt deleted file mode 100644 index 992d9a2..0000000 --- a/parse/experimental/steal-metafunction2.rkt +++ /dev/null @@ -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]))) - diff --git a/parse/experimental/template.rkt b/parse/experimental/template.rkt index 00e6856..53a7b54 100644 --- a/parse/experimental/template.rkt +++ b/parse/experimental/template.rkt @@ -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?) - "#") - - (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?) - "#")))))))) - #| 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))) ;; ============================================================ diff --git a/parse/experimental/test-steal.rkt b/parse/experimental/test-steal.rkt deleted file mode 100644 index 2980fa7..0000000 --- a/parse/experimental/test-steal.rkt +++ /dev/null @@ -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)) \ No newline at end of file diff --git a/test/test-compatibility1.rkt b/test/test-compatibility1.rkt index 42fc352..5fc5451 100644 --- a/test/test-compatibility1.rkt +++ b/test/test-compatibility1.rkt @@ -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) diff --git a/test/test-compatibility2.rkt b/test/test-compatibility2.rkt index 7aa6956..0e1e435 100644 --- a/test/test-compatibility2.rkt +++ b/test/test-compatibility2.rkt @@ -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))))]) \ No newline at end of file