use `normalize-definition`

pull/17/head
Matthew Butterick 9 years ago
parent 6c224835a8
commit c247a29af7

@ -21,8 +21,7 @@
(with-syntax ([(id contract lambda-exp) (lambdafy-with-contract stx)]) (with-syntax ([(id contract lambda-exp) (lambdafy-with-contract stx)])
#'(begin #'(begin
(define id lambda-exp) (define id lambda-exp)
(provide id) (provide+safe [id contract]))))
(make-safe-module [id contract]))))
;; for previously defined identifiers ;; for previously defined identifiers

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base) syntax/strip-context) (require (for-syntax racket/base) syntax/define)
(provide (all-defined-out)) (provide (all-defined-out))
@ -14,18 +14,16 @@
;; convert calling pattern to form (id contract body-exp) ;; convert calling pattern to form (id contract body-exp)
;; hoist contract out of lambda-exp entirely
(define-syntax-rule (lambdafy-with-contract stx) (define-syntax-rule (lambdafy-with-contract stx)
(syntax-case stx () (with-syntax ([(id (lambda args contract body-exp (... ...))) (let*-values ([(id-stx rhs-exp-stx) (normalize-definition stx (datum->syntax stx 'λ) #t #t)])
[(_ (id arg (... ...) . rest-arg) contract body0 body (... ...)) (list id-stx (syntax->list rhs-exp-stx)))])
(replace-context #'id #'(id contract (λ (arg (... ...) . rest-arg) body0 body (... ...))))] ;; lambda-exp = #'(lambda args body-exp (... ...))
[(_ id contract lambda-exp) #'(id contract (lambda args body-exp (... ...)))))
(replace-context #'id #'(id contract lambda-exp))]))
;; convert calling pattern to form (id body-exp) ;; convert calling pattern to form (id body-exp)
(define-syntax-rule (lambdafy stx) (define-syntax-rule (lambdafy stx)
(syntax-case stx () (with-syntax ([(id lambda-exp) (let-values ([(id-stx body-exp-stx) (normalize-definition stx (datum->syntax stx 'λ) #t #t)])
[(_ (id arg (... ...) . rest-arg) body0 body (... ...)) (list id-stx body-exp-stx))])
(replace-context #'id #'(id (λ (arg (... ...) . rest-arg) body0 body (... ...))))] #'(id lambda-exp)))
[(_ id lambda-exp)
(replace-context #'id #'(id lambda-exp))]))
Loading…
Cancel
Save