IIUC, that’s not what Shriram wants. He wants a kind of interface /
contract for a module (that it must export certain identifiers). The
solution that you posted makes the module satisfy the interface by
construction, but it creates another problem which is that he might
accidentally export a wrong identifier.
Wouldn’t create a test file suffice for detecting the original problem that
Shriram has, though? Something like this:
;; tester.rkt
#lang racket/base
(define required-ids '(+ - *))
(define files '("test-a.rkt" "test-b.rkt" "test-c.rkt"))
(define (error-handler e)
((error-display-handler) (exn-message e) e))
(for ([mod (in-list files)])
(parameterize ([current-namespace (make-base-namespace)])
(with-handlers ([exn:fail:syntax? error-handler])
(expand
`(module test racket/base
(require (only-in ,mod ,@required-ids)))))))
;; test-a.rkt
#lang racket/base
(provide + *)
;; test-b.rkt
#lang racket/base
(provide (rename-out [my-+ +]) - *)
(define (my-+ a b)
(+ a b 1))
;; test-c.rkt
#lang racket/base
(provide + -)
which produces:
only-in: identifier `-' not included in nested require spec in: "test-a.rkt"
only-in: identifier `*' not included in nested require spec in: "test-c.rkt"
On Wed, Sep 2, 2020, 1:12 PM Michael MacLeod <michaelmmacl...@gmail.com>
wrote:
> Does this example work: http://pasterack.org/pastes/95923?
>
> `if-not-defined` is written as a provide transformer which uses
> `syntax-local-module-defined-identifiers` to get the list of phase-0
> identifiers defined in the module.
>
> Best,
> Michael
>
> [code also pasted below]:
>
> #lang racket/base
>
> (module implementation racket/base
> (provide (if-not-defined "^my-"
> + ; my-+ from this module
> - ; - from racket/base
> * ; my-* from this module
> / ; / from racket/base
> ))
>
> (require (for-syntax racket/base
> racket/provide-transform
> syntax/parse))
>
> (define-syntax if-not-defined
> (make-provide-transformer
> (lambda (stx modes)
> (syntax-parse stx
> [(_ pattern:string var:id ...)
> (define regex (regexp (syntax-e #'pattern)))
> (define phase-0-ids
> (hash-ref (syntax-local-module-defined-identifiers) 0))
> (define (find-id+sym v)
> (define v-string (symbol->string (syntax-e v)))
> (for/or ([id (in-list phase-0-ids)])
> (define id-string (symbol->string (syntax-e id)))
> (define maybe-match
> (and (string=? v-string
> (regexp-replace regex id-string ""))
> (not (string=? id-string v-string))))
> (if maybe-match
> (cons id
> (string->symbol v-string))
> #f)))
> (for/fold ([exports '()])
> ([v (in-list (syntax->list #'(var ...)))])
> (define maybe-id+sym (find-id+sym v))
> (cond [maybe-id+sym
> (cons (export (car maybe-id+sym)
> (cdr maybe-id+sym)
> 0
> #f
> (car maybe-id+sym))
> exports)]
> [else
> (cons (export v
> (syntax-e v)
> 0
> #f
> v)
> exports)]))]))))
>
> (define (my-+ a b)
> (+ a b 100))
>
> (define (my-* a b)
> (* a b 100)))
>
> (require 'implementation rackunit)
>
> (check-equal? (+ 2 3) 105)
> (check-equal? (- 2 3) -1)
> (check-equal? (* 2 3) 600)
> (check-equal? (/ 2 3) 2/3)
>
> --
> You received this message because you are subscribed to the Google Groups
> "Racket Users" group.
> To unsubscribe from this group and stop receiving emails from it, send an
> email to racket-users+unsubscr...@googlegroups.com.
> To view this discussion on the web visit
> https://groups.google.com/d/msgid/racket-users/CACehHmBAd%2BhNHsO3CkthY5ojuZ%2B_Rgj87rKbQrPXrAw5Fxcw7w%40mail.gmail.com
> <https://groups.google.com/d/msgid/racket-users/CACehHmBAd%2BhNHsO3CkthY5ojuZ%2B_Rgj87rKbQrPXrAw5Fxcw7w%40mail.gmail.com?utm_medium=email&utm_source=footer>
> .
>
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
To view this discussion on the web visit
https://groups.google.com/d/msgid/racket-users/CADcuegtUnfR2S_-yZV%2BNHcB4AxgeLkntmi%2BV318YVWnXaw%3D0EQ%40mail.gmail.com.
