| PasteRack.org | ||
| Paste # 95923 | ||
| 2020-09-02 16:00:34 | ||
Fork as a new paste. | ||
Paste viewed 559 times. | ||
Tweet | ||
Embed: | ||
#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)