You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
72 lines
2.4 KiB
Racket
72 lines
2.4 KiB
Racket
#lang racket/base
|
|
(require (for-syntax racket/base
|
|
racket/syntax
|
|
syntax/strip-context
|
|
"private/syntax-utils.rkt")
|
|
racket/contract)
|
|
|
|
(define-syntax (make-safe-module stx)
|
|
(syntax-case stx ()
|
|
[(_ [ID CONTRACT])
|
|
;; need to put `racket/contract` inside calling location's context
|
|
(with-syntax ([RACKET/CONTRACT (datum->syntax #'ID 'racket/contract)])
|
|
#'(module+ safe
|
|
(require RACKET/CONTRACT)
|
|
(provide (contract-out [ID CONTRACT]))))]
|
|
[(_ ID)
|
|
#'(module+ safe
|
|
(provide ID))]))
|
|
|
|
(define-syntax (define+provide+safe stx)
|
|
(with-syntax ([(ID CONTRACT LAMBDA-EXP) (lambdafy-with-contract stx)])
|
|
#'(begin
|
|
(define ID LAMBDA-EXP)
|
|
(provide+safe [ID CONTRACT]))))
|
|
|
|
;; for previously defined identifiers
|
|
;; takes args like (provide+safe [id contract]) or just (provide+safe id)
|
|
;; any number of args.
|
|
(define-syntax-rule (provide+safe THING ...)
|
|
(begin
|
|
(provide+safe/once THING) ...))
|
|
|
|
;; `provide+safe` might have interleaved ids or [id contract] args so handle them individually.
|
|
(define-syntax (provide+safe/once stx)
|
|
(with-syntax ([(ID MSM-ARG) (syntax-case stx ()
|
|
[(_ [ID contract])
|
|
#'(ID [ID contract])]
|
|
[(_ id)
|
|
#'(id id)])])
|
|
#'(begin
|
|
(provide ID)
|
|
(make-safe-module MSM-ARG))))
|
|
|
|
(define-syntax (define+provide/contract stx)
|
|
(with-syntax* ([(ID CONTRACT LAMBDA-EXP) (lambdafy-with-contract stx)]
|
|
[RACKET/CONTRACT (datum->syntax #'ID 'racket/contract)])
|
|
#'(begin
|
|
(require RACKET/CONTRACT)
|
|
(provide (contract-out [ID CONTRACT]))
|
|
(define ID LAMBDA-EXP))))
|
|
|
|
(define-syntax (define/contract+provide stx)
|
|
(with-syntax* ([(ID CONTRACT LAMBDA-EXP) (lambdafy-with-contract stx)]
|
|
[RACKET/CONTRACT (datum->syntax #'ID 'racket/contract)])
|
|
#'(begin
|
|
(require RACKET/CONTRACT)
|
|
(provide ID)
|
|
(define/contract ID CONTRACT LAMBDA-EXP))))
|
|
|
|
(define-syntax (define+provide stx)
|
|
(with-syntax ([(ID LAMBDA-EXP) (lambdafy stx)])
|
|
#'(begin
|
|
(provide ID)
|
|
(define ID LAMBDA-EXP))))
|
|
|
|
(provide+safe make-safe-module
|
|
define+provide+safe
|
|
provide+safe
|
|
define+provide/contract
|
|
define/contract+provide
|
|
define+provide)
|