diff --git a/main.rkt b/main.rkt index 3961b20..82e8652 100644 --- a/main.rkt +++ b/main.rkt @@ -63,13 +63,15 @@ ...] ...) #:with ((old-generated-id ...) ...) - (map (λ (id meanings) (map (λ (meaning) (gen-id id meaning)) meanings)) + (map (λ (id meanings) (map (λ (meaning) (gen-id id (syntax-e meaning))) + (syntax->list meanings))) (syntax->list #'(old-id ...)) - (map syntax-e (syntax->list #'((meaning ...) ...)))) - #:with (new-generated-id ...) - (map (λ (id meanings) (map (λ (meaning) (gen-id id meaning)) meanings)) + (syntax->list #'((meaning ...) ...))) + #:with ((new-generated-id ...) ...) + (map (λ (id meanings) (map (λ (meaning) (gen-id id (syntax-e meaning))) + (syntax->list meanings))) (syntax->list #'(new-id ...)) - (map syntax-e (syntax->list #'((meaning ...) ...)))) + (syntax->list #'((meaning ...) ...))) #:with (new-id-no-duplicates ...) (remove-duplicates (syntax->list #'(new-id ...)) free-identifier=?) @@ -124,12 +126,12 @@ (map (λ (one-id) (gen-id one-id '| safeguard |)) (syntax->list #'(new-id ...)))]) (register-meanings (syntax->datum #'(meaning ... ...))) - (expand-export #'(combine-out new-id ... - safeguard ... - (rename-out [old-generated-id - new-generated-id] - ... ...)) - modes))])))) + (pre-expand-export #'(combine-out new-id ... + safeguard ... + (rename-out [old-generated-id + new-generated-id] + ... ...)) + modes))])))) ;; Definition of polysemic identifiers and parts of these ;; _____________________________________________________________________________ @@ -267,7 +269,7 @@ (for ([expanded (in-list expanded*)]) (when (free-id-set-member? covered-ids expanded) (raise-syntax-error 'polysemy - "Overlap between function cases" + "some available function cases overlap" stx #f pred-ids)) diff --git a/test/test-2-require.rkt b/test/test-2-require.rkt index 8d7b561..b67e6c3 100644 --- a/test/test-2-require.rkt +++ b/test/test-2-require.rkt @@ -2,12 +2,16 @@ (require polysemy rackunit + syntax/macro-testing (poly-rename-in "test-2-provide.rkt" - [foo |(poly-case string?)| bar] - [bar |(poly-case string?)| foo])) + [[foo bar] |(poly-case string?)|] + [[bar foo] |(poly-case string?)|])) (check-equal? (foo 1) 11) (check-equal? (foo "abc") "bar-abc") (check-equal? (bar 1) 21) (check-equal? (bar "abc") 3) -(baz "abc") \ No newline at end of file +(check-exn #px"overlap" + (λ () + (convert-compile-time-error + (baz "abc")))) \ No newline at end of file diff --git a/test/test-require.rkt b/test/test-require.rkt index 430ca5a..604e1e1 100644 --- a/test/test-require.rkt +++ b/test/test-require.rkt @@ -1,15 +1,15 @@ #lang racket -(provide (poly-out [baz identifier-macro match-expander])) - (require polysemy rackunit) +(provide (poly-out [baz identifier-macro match-expander])) + (require (poly-rename-in "test-provide.rkt" - [foo identifier-macro baz]) + [(foo baz) identifier-macro]) (poly-rename-in "test-provide-b.rkt" - [bar identifier-macro foo] - [bar match-expander baz] + [(bar foo) identifier-macro] + [(bar baz) match-expander] [foo match-expander])) (define-poly bar identifier-macro (λ (stx) #'"overridden bar")) @@ -36,4 +36,4 @@ '((a aa aaa) (b bb bbb))) (check-equal? (my-macro2 a aa aaa foo b bb bbb) - '((a aa aaa) 42 (b bb bbb))) \ No newline at end of file + '((a aa aaa) 42 (b bb bbb)))