PasteRack.org
Paste # 95923
2020-09-02 16:00:34

Fork as a new paste.

Paste viewed 498 times.


Embed:

if-not-defined provide transformer

#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)