light-no-check.rkt (1718B)
1 #lang racket/base 2 3 (provide (except-out (all-from-out racket/base) 4 define) 5 (rename-out [new-: :] 6 [new-define-type define-type] 7 [new-define define] 8 [new-require/typed require/typed])) 9 10 (require (for-syntax racket/base)) 11 12 (begin-for-syntax 13 (define (process-arg stx) 14 (syntax-case stx (new-:) 15 [id/kw (or (identifier? #'id/kw) (keyword? (syntax-e #'id/kw))) #'id/kw] 16 [[_ _] stx] ;; [arg default] 17 [[arg new-: _] #'arg] 18 [[arg new-: _ default] #'[arg default]])) 19 (define (process-curried stx) 20 (syntax-case stx () 21 [id (identifier? #'id) #'id] 22 [(recur arg ...) 23 (with-syntax ([recur.no-types (process-curried #'recur)] 24 [(arg.no-types ...) 25 (map process-arg (syntax->list #'(arg ...)))]) 26 #'(recur.no-types arg.no-types ...))]))) 27 28 (define-syntax (new-: stx) #'(begin)) 29 (define-syntax (new-define-type stx) #'(begin)) 30 (define-syntax (new-define stx) 31 (syntax-case stx (new-:) 32 [(_ #:∀ _ curried new-: _ e ...) 33 (with-syntax ([curried.no-types (process-curried #'curried)]) 34 #'(define curried.no-types e ...))] 35 [(_ #:∀ _ curried e ...) 36 (with-syntax ([curried.no-types (process-curried #'curried)]) 37 #'(define curried.no-types e ...))] 38 [(_ curried new-: _ e ...) 39 (with-syntax ([curried.no-types (process-curried #'curried)]) 40 #'(define curried.no-types e ...))] 41 [(_ curried e ...) 42 (with-syntax ([curried.no-types (process-curried #'curried)]) 43 #'(define curried.no-types e ...))])) 44 45 (define-syntax-rule (new-require/typed mod [id τ] ...) 46 (require (only-in mod id ...)))