Merge pull request #11 from samth/fix-new-expander

This fixes sugar and pollen to work with the new expander. I believe that it will work on 6.2 as well.
pull/13/head
Matthew Butterick 9 years ago
commit 947d9040d1

@ -7,15 +7,16 @@
(define-syntax (module-test-external stx) (define-syntax (module-test-external stx)
(syntax-case stx () (syntax-case stx ()
[(_ expr ...) [(_ expr ...)
(with-syntax ([mod-name (generate-temporary)]) (let ([mod-name (syntax-e (generate-temporary))])
#'(begin (datum->syntax stx
(module* mod-name racket/base `(begin
(module* ,mod-name racket/base
(require (submod "..")) (require (submod ".."))
(require rackunit) (require rackunit)
expr ...) ,@(syntax->datum #'(expr ...)))
(module+ test (module+ test
(require (submod ".." mod-name)))))])) (require (submod ".." ,mod-name))))
stx))]))
(define-syntax (module-test-internal stx) (define-syntax (module-test-internal stx)
(syntax-case stx () (syntax-case stx ()

@ -4,27 +4,31 @@
(define-syntax (eval-as-untyped stx) (define-syntax (eval-as-untyped stx)
(syntax-case stx () (syntax-case stx ()
[(_ exprs ...) [(_ exprs ...)
(with-syntax ([sym (generate-temporary)] (let ([sym (generate-temporary)]
[sym2 (generate-temporary)]) [sym2 (generate-temporary)])
#'(begin (datum->syntax
(module sym racket stx
`(begin
(module ,sym racket
(require rackunit "../main.rkt" net/url) (require rackunit "../main.rkt" net/url)
exprs ...) ,@(syntax->datum #'(exprs ...)))
(require 'sym) (require ',sym)
(module sym2 racket (module ,sym2 racket
(require rackunit (submod "../main.rkt" safe) net/url) (require rackunit (submod "../main.rkt" safe) net/url)
exprs ...) ,@(syntax->datum #'(exprs ...)))
(require 'sym2)))])) (require ',sym2))))]))
(define-syntax (eval-as-typed stx) (define-syntax (eval-as-typed stx)
(syntax-case stx () (syntax-case stx ()
[(_ exprs ...) [(_ exprs ...)
(with-syntax ([sym (generate-temporary)]) (let ([sym (generate-temporary)])
#'(begin (datum->syntax stx
(module sym typed/racket `(begin
(module ,sym typed/racket
(require typed/rackunit "../../typed/sugar.rkt" typed/net/url) (require typed/rackunit "../../typed/sugar.rkt" typed/net/url)
exprs ...) ,@(syntax->datum #'(exprs ...)))
(require 'sym)))])) (require ',sym))
stx))]))
(define-syntax-rule (eval-as-typed-and-untyped exprs ...) (define-syntax-rule (eval-as-typed-and-untyped exprs ...)
(begin (begin
@ -59,7 +63,7 @@
(check-equal? (->list '(1 2 3)) '(1 2 3)) (check-equal? (->list '(1 2 3)) '(1 2 3))
(check-equal? (->list (list->vector '(1 2 3))) '(1 2 3)) (check-equal? (->list (list->vector '(1 2 3))) '(1 2 3))
(check-equal? (->list (set 1 2 3)) '(3 2 1)) (check-not-false (andmap (lambda (e) (member e '(1 2 3))) (->list (set 1 2 3))))
(check-equal? (->list "foo") (list "foo")) (check-equal? (->list "foo") (list "foo"))
(check-true (->boolean #t)) (check-true (->boolean #t))

Loading…
Cancel
Save