From 5a5c0e3a77690658e1d0c2a6158669d6299d3f07 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 31 Mar 2016 12:28:27 -0700 Subject: [PATCH] clarifications --- sugar/private/syntax-utils.rkt | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/sugar/private/syntax-utils.rkt b/sugar/private/syntax-utils.rkt index 0cd9d4f..a65fa7b 100644 --- a/sugar/private/syntax-utils.rkt +++ b/sugar/private/syntax-utils.rkt @@ -1,6 +1,6 @@ #lang racket/base (require (for-syntax racket/base) syntax/define) -(provide (all-defined-out)) +(provide (except-out (all-defined-out) values->list)) (define-syntax-rule (require+provide/safe modname ...) @@ -13,21 +13,28 @@ (provide (all-from-out (submod modname safe))))) ...)) +(define-syntax (values->list stx) + (syntax-case stx () + [(_ values-expr) #'(call-with-values (λ () values-expr) list)])) + ;; convert calling pattern to form (id contract body-exp) ;; hoist contract out of lambda-exp entirely (define-syntax-rule (lambdafy-with-contract stx) (syntax-case stx () - [(_ id contract lambda-exp) - ;; `normalize-definition` can't handle the `define/contract` pattern of three expressions after the `define`. + + [(_ id-exp contract lambda-exp) ; matches exactly three args after `define` + ;; `normalize-definition` can't handle the acceptable `define/contract` pattern of id, contract, lambda exp after the `define`. ;; so extract the contract, and then put id & lambda-exp back together, and let `normalize-definition` destructure as usual. - (with-syntax ([(new-id new-lambda-exp) (let-values ([(id-stx body-exp-stx) (normalize-definition #'(_ id lambda-exp) (datum->syntax stx 'λ) #t #t)]) - (list id-stx body-exp-stx))]) + (with-syntax ([(new-id new-lambda-exp) (values->list (normalize-definition #'(_ id-exp lambda-exp) (datum->syntax #'id-exp 'λ) #t #t))]) #'(new-id contract new-lambda-exp))] - [else - (with-syntax ([(id (lambda args contract body-exp (... ...))) (let*-values ([(id-stx rhs-exp-stx) (normalize-definition stx (datum->syntax stx 'λ) #t #t)]) - (list id-stx (syntax->list rhs-exp-stx)))]) + + [(_ id-exp maybe-contract body-exp (... ...)) ; matches two, or four or more + (with-syntax ([(id (lambda args contract body-exp (... ...))) (values->list (normalize-definition stx (datum->syntax #'id-exp 'λ) #t #t))]) ;; lambda-exp = #'(lambda args body-exp (... ...)) - #'(id contract (lambda args body-exp (... ...))))])) + #'(id contract (lambda args body-exp (... ...))))] + + [else ; matches zero or one arugments + (error 'define-macro "not enough arguments")])) ;; convert calling pattern to form (id body-exp)