From 8ff2ab25303f362a0ce2ae46ce366ec4113702ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Sat, 6 May 2017 18:03:41 +0200 Subject: [PATCH] Support functions of two arguments as type expanders (so that they can access the prop:type-expander? struct instance itself). Provided prop:type-expander? and prop-type-expander-ref --- scribblings/type-expander.scrbl | 19 ++++++++--- type-expander.hl.rkt | 57 ++++++++++++++++++++++----------- 2 files changed, 53 insertions(+), 23 deletions(-) diff --git a/scribblings/type-expander.scrbl b/scribblings/type-expander.scrbl index c029d56..5c27fb6 100644 --- a/scribblings/type-expander.scrbl +++ b/scribblings/type-expander.scrbl @@ -320,17 +320,26 @@ arguments. More than two levels of nesting are possible. assignment transformer} macros with the syntax @racket[(set! macro-name arg …)] as an argument).} -@defthing[prop:type-expander struct-type-property?]{ +@deftogether[ + (@defthing[prop:type-expander + (struct-type-property/c + (or/c exact-positive-integer? + (→ prop:type-expander? any/c any/c) + (→ any/c any/c)))] + @defproc[(prop:type-expander? [v any/c]) boolean?] + @defproc[(prop:type-expander-ref [v prop:type-expander?]) any/c])]{ A @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{ structure type property} to identify structure types that act as @tech[#:key "type expander"]{type expanders} like the ones created by @racket[define-type-expander]. - The property value must be a procedure of arity 1 or an - @racket[exact-nonnegative-integer?] designating a field - index within the structure which contains such a - procedure. + The property value must be a procedure of arity 1 or 2, or an + @racket[exact-nonnegative-integer?] designating a field index within the + structure which contains such a procedure. If the procedure's arity includes + 2, then the first argument is the structure itself (which satisfies + @racket[prop:type-expander?]), and the second argument is the syntax object to + transform. Otherwise, the single argument is the syntax object to transform. The procedure serves as a syntax transformer when expanding the use of a type expander. If the type expander diff --git a/type-expander.hl.rkt b/type-expander.hl.rkt index b692771..44d371e 100644 --- a/type-expander.hl.rkt +++ b/type-expander.hl.rkt @@ -426,8 +426,8 @@ identifier would have to implement the @tc[prop:rename-transformer], (make-struct-type-property 'type-expander prop-guard))] The value of the @tc[prop:type-expander] property should either be a -transformer procedure which will be called when expanding the type, or the -index of a field containing such a procedure. +transformer procedure of one or two arguments which will be called when +expanding the type, or the index of a field containing such a procedure. @chunk[ (define (prop-guard val struct-type-info-list) @@ -453,13 +453,19 @@ corresponding to the use of the expander. If the property's value is a procedure, we therefore check that its arity includes 1. @chunk[ - (if (and (procedure? type-expander) - (arity-includes? (procedure-arity type-expander) 1)) - type-expander - (raise-argument-error 'prop:type-expander-guard - (~a "the value of the " val "-th field should" - " be a procedure whose arity includes 1") - type-expander))] + (cond + [(and (procedure? type-expander) + (arity-includes? (procedure-arity type-expander) 2)) + (curry type-expander instance)] + [(and (procedure? type-expander) + (arity-includes? (procedure-arity type-expander) 1)) + type-expander] + [else + (raise-argument-error 'prop:type-expander-guard + (~a "the value of the " val "-th field should" + " be a procedure whose arity includes 1 or" + " 2") + type-expander)])] In the first case, when the property value is a field index, we return an accessor function. The accessor function expects a struct instance, performs @@ -472,11 +478,15 @@ argument). @chunk[ [(procedure? val) - (if (arity-includes? (procedure-arity val) 1) - (λ (_) val) - (raise-argument-error 'prop:type-expander-guard - "a procedure whose arity includes 1" - val))]] + (cond + [(arity-includes? (procedure-arity val) 2) + (λ (s) (curry val s))] + [(arity-includes? (procedure-arity val) 1) + (λ (_) val)] + [else + (raise-argument-error 'prop:type-expander-guard + "a procedure whose arity includes 1 or 2" + val)])]] When the value of the @racket[prop:type-expander] property is neither a positive field index nor a procedure, an error is raised: @@ -485,10 +495,10 @@ positive field index nor a procedure, an error is raised: [else (raise-argument-error 'prop:type-expander-guard - (~a "a procedure whose arity includes 1, or an exact " + (~a "a procedure whose arity includes 1 or 2, or an exact " "non-negative integer designating a field index within " "the structure that should contain a procedure whose " - "arity includes 1.") + "arity includes 1 or 2.") val)]] @subsection{The @racket[type-expander] struct} @@ -1823,10 +1833,19 @@ will be written in @tc[racket], not @tc[typed/racket]). syntax/stx auto-syntax-e "parameterize-lexical-context.rkt" - debug-scopes) + debug-scopes + racket/contract/base) ;; TODO: move this in a separate chunk and explain it (provide prop:type-expander + (contract-out + (rename has-prop:type-expander? + prop:type-expander? + (-> any/c boolean?)) + (rename get-prop:type-expander-value + prop:type-expander-ref + (-> has-prop:type-expander? + any/c))) type-expander apply-type-expander ;bind-type-vars @@ -1877,8 +1896,10 @@ We can finally define the overloaded forms, as well as the (require (submod ".." expander)) (require (for-syntax (submod ".." expander))) (require (for-syntax typed-racket/base-env/annotate-classes)) - + (provide prop:type-expander + prop:type-expander? + prop:type-expander-ref expand-type define-type-expander patch-type-expander