provide-if-not-defined

47 views
Skip to first unread message

Shriram Krishnamurthi

unread,
Sep 2, 2020, 10:29:12 AM9/2/20
to Racket Users
Related to my previous post [https://groups.google.com/g/racket-users/c/OqyqDFxwhf0], I have several cases where I have this kind of pattern:

V1:

#lang racket
(provide +)

V2:

#lang racket
(provide [rename-out (my-+ +)])
(define my-+ …)

Each variant provides some/all primitives directly from the module's lang, while a sibling variant changes their behavior.

Since there are a lot of names, it gets tiresome to remember which things have and haven't been exported. Duplicates are of course caught statically, but missing names are not "caught" at all at module definition time.

It'd be nice to be able to write, say a block like

#lang racket
(provide-if-not-defined +)

at the top of BOTH files. In V1, this turns into provide; in V2 I'd still write the rename-out, but would only need to do this for the (usually) small number of operations that I am overriding. Having a common block at the top of each variant would ensure that the variants provide the same language.

Shriram

Michael MacLeod

unread,
Sep 2, 2020, 4:12:03 PM9/2/20
to Shriram Krishnamurthi, Racket Users
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)

Sorawee Porncharoenwase

unread,
Sep 2, 2020, 4:56:52 PM9/2/20
to Michael MacLeod, Shriram Krishnamurthi, Racket Users

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"


--
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...@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.

Shriram Krishnamurthi

unread,
Sep 3, 2020, 11:09:46 AM9/3/20
to Sorawee Porncharoenwase, Michael MacLeod, Racket Users
Thank you both.

What I want is something closer to what Oak wrote, but that addresses only *checking*, whereas I also want the convenience of defining the module.

So to use Oak's example, I want to be able to write

    #lang racket/base

    (provide-if-not-defined + - *)

at the top of *all three files*, but in test-b.rkt, also write

    (provide [rename-out (my-+ +)])

So yes, if it turns out, say, `*` is not in racket/base, then all three files will indeed give me an error (at definition), like Oak's checker would. But this also reduces error by letting me duplicate the interface across files, while still being able to override parts of it, like in test-b.rkt, without producing an error that + is being exported twice.

Shriram

Greg Hendershott

unread,
Sep 3, 2020, 12:57:29 PM9/3/20
to Racket Users
What if you instead rename the lang's imports (e.g. with prefix-in), and rely on the fact that your definitions override those supplied by the lang?

That way you could write the exact same provide for all the files: "provide-if-not-defined" is simply provide. However, you would need to manually use the renamed imports in your implmentation.

Rough sketch:

#lang racket/base

(module v1 racket/base
 
(provide +))

(module v2 racket/base
 
(provide +)
 
(require (prefix-in rkt: racket/base))
 
;; At this point, both + and rkt:+ are aliases.
 
;; But after the the following definition, + is yours:
 
(define (+ . vs) ;; like racket/base + but wrapped in a list
   
(list (apply rkt:+ vs))))

;; (require 'v1)
;; (+ 1 2) => 3

;; (require '
v2)
;; (+ 1 2) => '(3)


Shriram Krishnamurthi

unread,
Sep 3, 2020, 1:12:49 PM9/3/20
to Greg Hendershott, Racket Users
Ah, I see, that's a nice idea!

One problem is have well over a dozen of these that I want to pass-through, but I suppose I could write a

(rename-prefix <prefix> <name> ...)

that turns into a bunch of define's. I'd have to be careful to not miss any.

Another issue is that I have to redefine some of the language-definition primitives (like #%app), which will definitely make the module far more tricky.

Sorawee Porncharoenwase

unread,
Sep 3, 2020, 1:57:51 PM9/3/20
to Shriram Krishnamurthi, Greg Hendershott, Racket Users

I want to propose another interface:

(my-provide 
  #:default + - *
  #:override 
  [my-+ +])

which expands to:

(provide - *)
(provide (rename-out [my-+ +]))

and checks that + must be in the #:default section (because we are overriding it, it’d better already exist).

More generally:

(my-provide 
  #:default <ids> ...
  #:override 
  [<lhs> <rhs>] ...)

expands to:

(provide (rename-out [<lhs> <rhs>] ...))
(provide <ids*> ...)

where ids* = ids - rhs, and with a check that rhsids

--
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...@googlegroups.com.
Reply all
Reply to author
Forward
0 new messages