From fe80d8c0285b07d78cd80b29b86af398b5eac3d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 10 May 2017 03:34:07 +0200 Subject: [PATCH] More documentation, fixed some bugs. --- info.rkt | 4 +- main.rkt | 245 +++++++++++++++++++++---------------- private/ids.rkt | 40 ++++-- scribblings/polysemy.scrbl | 167 ++++++++++++++++++++++++- 4 files changed, 334 insertions(+), 122 deletions(-) diff --git a/info.rkt b/info.rkt index 230a07e..3b2705e 100644 --- a/info.rkt +++ b/info.rkt @@ -1,8 +1,8 @@ #lang info (define collection "polysemy") -(define deps '("base" +(define deps '(("base" "6.3") "rackunit-lib")) -(define build-deps '("scribble-lib" +(define build-deps '(("scribble-lib" "1.16") "racket-doc")) (define scribblings '(("scribblings/polysemy.scrbl" ()))) (define pkg-desc diff --git a/main.rkt b/main.rkt index d44f96e..5eda2d7 100644 --- a/main.rkt +++ b/main.rkt @@ -1,121 +1,19 @@ #lang racket/base -(provide - ;; A require transformer - poly-rename-in - ;; Another require transformer - poly-only-in - ;; Provide transformer - poly-out - ;; Definition of a polysemic id, and of a part of a polysemic id - define-poly - ;; Syntax-parse pattern expander which extracts the given meaning from the id - (for-syntax ~poly) - ;; Defines a literal which can be renamed, without conflicting with other - ;; poly literals, or identifiers with other meanings. - define-poly-literal - ;; Defines a static overload for a polysemic method - define-poly-case) +;; The provide form is at the bottom of the file, as it needs to use some +;; provide transformers defined within this file. (require "private/ids.rkt" racket/contract ;; TODO: remove if not needed. (for-syntax racket/base racket/list - racket/set racket/require-transform racket/provide-transform syntax/parse - syntax/id-table - syntax/id-set "private/utils.rkt" - racket/contract - racket/syntax) + racket/contract) (for-meta 2 racket/base)) -;; Require transformers -;; _____________________________________________________________________________ - -;; Common implementation for the poly-rename-in and poly-only-in rename -;; transformers. -(define-for-syntax (poly-require-transformer req stx) - (syntax-parse stx - [(_ mod - [{~or {~and :id old-id new-id} - (old-id:id new-id:id)} - meaning:id - ...] - ...) - #:with ((old-generated-id ...) ...) - (map (λ (id meanings) (map (λ (meaning) (gen-id id (syntax-e meaning))) - (syntax->list meanings))) - (syntax->list #'(old-id ...)) - (syntax->list #'((meaning ...) ...))) - #:with ((new-generated-id ...) ...) - (map (λ (id meanings) (map (λ (meaning) (gen-id id (syntax-e meaning))) - (syntax->list meanings))) - (syntax->list #'(new-id ...)) - (syntax->list #'((meaning ...) ...))) - #:with (new-id-no-duplicates ...) - (remove-duplicates (syntax->list #'(new-id ...)) - free-identifier=?) - #:with (new-safeguard-no-duplicates ...) - (map (λ (one-id) (gen-id one-id '| safeguard |)) - (syntax->list #'(new-id-no-duplicates ...))) - (register-meanings (syntax->datum #'(meaning ... ...))) - (expand-import - #`(combine-in - ;; We always require the same ids, so that multiple requires - ;; are a no-op, instead of causing conflicts. - (only-in polysemy/private/ids - [the-polysemic-id new-id-no-duplicates] ... - [the-safeguard-id new-safeguard-no-duplicates] ...) - (#,req mod [old-generated-id new-generated-id] ... ...)))])) - -;; Require transformer which allows renaming parts of polysemic identifiers. -(define-syntax poly-rename-in - (make-require-transformer - (λ (stx) (poly-require-transformer #'rename-in stx)))) - -;; Require transformer which allows selecting and renaming parts of polysemic -;; identifiers. -(define-syntax poly-only-in - (make-require-transformer - (λ (stx) (poly-require-transformer #'only-in stx)))) - -;; Provide transformers -;; _____________________________________________________________________________ - -(define-syntax poly-out - (make-provide-pre-transformer - (λ (provide-spec modes) - (syntax-parse provide-spec - [(_ [{~or {~and :id old-id new-id} (old-id:id new-id:id)} meaning ...] - ...) - (with-syntax ([((old-generated-id ...) ...) - (map (λ (one-id meanings) - (map (λ (one-meaning) - (gen-id one-id (syntax-e one-meaning))) - (syntax->list meanings))) - (syntax->list #'(old-id ...)) - (syntax->list #'((meaning ...) ...)))] - [((new-generated-id ...) ...) - (map (λ (one-id meanings) - (map (λ (one-meaning) - (gen-id one-id (syntax-e one-meaning))) - (syntax->list meanings))) - (syntax->list #'(new-id ...)) - (syntax->list #'((meaning ...) ...)))] - [(safeguard ...) - (map (λ (one-id) (gen-id one-id '| safeguard |)) - (syntax->list #'(new-id ...)))]) - (register-meanings (syntax->datum #'(meaning ... ...))) - (pre-expand-export #'(combine-out new-id ... - safeguard ... - (rename-out [old-generated-id - new-generated-id] - ... ...)) - modes))])))) - ;; Definition of polysemic identifiers and parts of these ;; _____________________________________________________________________________ @@ -208,6 +106,141 @@ [the-case-dispatch generated-identifier-macro]))}) (define/contract (tmp-f arg₀ argᵢ ...) - (-> pred? (or/c 'argᵢ any/c) ... any) + (-> pred? (or/c 'argᵢ 'TODO any/c) ... any) . body) (define-syntax generated-name (a-case #'tmp-f #'pred?)))))])) + +;; Require/provide transformers +;; _____________________________________________________________________________ + + +(begin-for-syntax + (define-syntax-class poly-meaning-expander-sc + #:attributes ([expanded 1]) + (pattern {~poly x poly-reqprov-id-expander} + #:with (tmp:poly-meaning-expander-sc ...) + ((attribute x.value) #'x) + #:with (expanded ...) #'(tmp.expanded ... ...)) + (pattern x:id #:with (expanded ...) #'(x)) + (pattern {~and whole ({~poly x poly-meaning-expander} . _)} + #:with (tmp:poly-meaning-expander-sc ...) + ((attribute x.value) #'whole) + #:with (expanded ...) #'(tmp.expanded ... ...)))) +(define-poly case-function poly-meaning-expander + (λ (stx) + (syntax-case stx () + ;; TODO: make the normal-macro and identifier-macro switchable. + [(_ pred?) #`(normal-macro + identifier-macro + #,(string->symbol + (format "~a" `(poly-case ,(syntax-e #'pred?)))))]))) + +;; Require transformers +;; _____________________________________________________________________________ + +;; Common implementation for the poly-rename-in and poly-only-in rename +;; transformers. +(define-for-syntax (poly-require-transformer req stx) + (syntax-parse stx + [(_ mod + [{~or {~and :id old-id new-id} (old-id:id new-id:id)} + meaning:poly-meaning-expander-sc + ...] + ...) + #:with ((old-generated-id ...) ...) + (map (λ (id meanings) + (map (λ (meaning) (gen-id id (syntax-e meaning))) + (remove-duplicates (syntax->list meanings) free-identifier=?))) + (syntax->list #'(old-id ...)) + (syntax->list #'((meaning.expanded ... ...) ...))) + #:with ((new-generated-id ...) ...) + (map (λ (id meanings) + (map (λ (meaning) (gen-id id (syntax-e meaning))) + (remove-duplicates (syntax->list meanings) free-identifier=?))) + (syntax->list #'(new-id ...)) + (syntax->list #'((meaning.expanded ... ...) ...))) + #:with (new-id-no-duplicates ...) + (remove-duplicates (syntax->list #'(new-id ...)) + free-identifier=?) + #:with (new-safeguard-no-duplicates ...) + (map (λ (one-id) (gen-id one-id '| safeguard |)) + (syntax->list #'(new-id-no-duplicates ...))) + (register-meanings (syntax->datum #'(meaning.expanded ... ... ...))) + (expand-import + #`(combine-in + ;; We always require the same ids, so that multiple requires + ;; are a no-op, instead of causing conflicts. + (only-in polysemy/private/ids + [the-polysemic-id new-id-no-duplicates] ... + [the-safeguard-id new-safeguard-no-duplicates] ...) + (#,req mod [old-generated-id new-generated-id] ... ...)))])) + +;; Require transformer which allows renaming parts of polysemic identifiers. +(define-syntax poly-rename-in + (make-require-transformer + (λ (stx) (poly-require-transformer #'rename-in stx)))) + +;; Require transformer which allows selecting and renaming parts of polysemic +;; identifiers. +(define-syntax poly-only-in + (make-require-transformer + (λ (stx) (poly-require-transformer #'only-in stx)))) + +;; Provide transformer +;; _____________________________________________________________________________ + +(define-syntax poly-out + (make-provide-pre-transformer + (λ (provide-spec modes) + (syntax-parse provide-spec + [(_ [{~or {~and :id old-id new-id} (old-id:id new-id:id)} + meaning:poly-meaning-expander-sc ...] + ...) + (with-syntax ([((old-generated-id ...) ...) + (map (λ (one-id meanings) + (map (λ (one-meaning) + (gen-id one-id (syntax-e one-meaning))) + (remove-duplicates (syntax->list meanings) + free-identifier=?))) + (syntax->list #'(old-id ...)) + (syntax->list #'((meaning.expanded ... ...) ...)))] + [((new-generated-id ...) ...) + (map (λ (one-id meanings) + (map (λ (one-meaning) + (gen-id one-id (syntax-e one-meaning))) + (remove-duplicates (syntax->list meanings) + free-identifier=?))) + (syntax->list #'(new-id ...)) + (syntax->list #'((meaning.expanded ... ...) ...)))] + [(old-safeguard ...) + (map (λ (one-id) (gen-id one-id '| safeguard |)) + (syntax->list #'(old-id ...)))] + [(new-safeguard ...) + (map (λ (one-id) (gen-id one-id '| safeguard |)) + (syntax->list #'(new-id ...)))]) + (register-meanings (syntax->datum #'(meaning.expanded ... ... ...))) + (pre-expand-export #'(rename-out [old-safeguard new-safeguard] ... + [old-id new-id] ... + [old-generated-id new-generated-id] + ... ...) + modes))])))) + +(provide + ;; A require transformer + poly-rename-in + ;; Another require transformer + poly-only-in + ;; Provide transformer + poly-out + ;; Definition of a polysemic id, and of a part of a polysemic id + define-poly + ;; Syntax-parse pattern expander which extracts the given meaning from the id + (for-syntax ~poly) + ;; Defines a literal which can be renamed, without conflicting with other + ;; poly literals, or identifiers with other meanings. + define-poly-literal + ;; Defines a static overload for a polysemic method + define-poly-case + ;; Syntactic token used to build case-function meanings + ;; TODO: We probably should make it a case-function-expander instead of a token + (poly-out [case-function poly-meaning-expander])) diff --git a/private/ids.rkt b/private/ids.rkt index 92d95ce..befe2a7 100644 --- a/private/ids.rkt +++ b/private/ids.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/match + racket/contract (for-syntax racket/base racket/contract racket/set @@ -97,7 +98,10 @@ #:property prop:match-expander (make-wrapper 'match-expander (λ (id) #`(var #,id)) - (λ (stx id args) (datum->syntax stx `(,id . ,args) stx stx))) + (λ (stx id args) (raise-syntax-error + 'match + "syntax error in pattern" + stx))) #:property prop:procedure macro-wrapper)) ;; The only polysemic id (all others are renamings of this one) @@ -105,6 +109,8 @@ ;; Record all known meanigns, so that the-case-dispatch-impl can perform some ;; sanity checks. +(define-for-syntax ignore-err-rx + #px"not currently transforming an expression within a module declaration") (begin-for-syntax (define/contract all-meanings (set/c symbol? #:kind 'mutable) (mutable-set)) (define/contract (register-meanings-end syms) @@ -116,9 +122,15 @@ (-> (listof symbol?) void?) (for ([meaning (in-list syms)]) (set-add! all-meanings meaning)) - (syntax-local-lift-module-end-declaration - #`(begin-for-syntax - (register-meanings-end '#,syms))))) + (with-handlers ([(λ (e) + (and exn:fail:contract? + (not (eq? (syntax-local-context) 'module)) + (regexp-match ignore-err-rx (exn-message e)))) + (λ (e) (void))]) + ;; I'm not sure if this is really needed. + (syntax-local-lift-module-end-declaration + #`(begin-for-syntax + (register-meanings-end '#,syms)))))) (begin-for-syntax ;; Represents a single overload of a function (function-id + predicate-id) @@ -142,6 +154,8 @@ (,#'exact? . (,#'number?)) ;; not quite right (,#'number? . (,#'any/c)) (,#'zero? . (,#'integer?)) + (,#'boolean? . (,#'any/c)) + (,#'list? . (,#'any/c)) #;…)))) ;; Lazily fill in the "expansion" hash table, to avoid compile-time costs ;; when the module is later required. @@ -209,12 +223,18 @@ ;; TODO: for now, this only supports a single argument. ;; we should generalize it to support case-λ, and dispatch on ;; multiple arguments - ;; TODO: use syntax-local-lift-module-end-declaration to cache - ;; the generated dispatch functions. - #`(λ (arg) - (cond - [(pred-id arg) (f-id arg)] - ...)))])) + ;; TODO: use syntax-local-lift-expression to cache + ;; the generated dispatch functions. Beware of all the failure + ;; modes: it is very easy to lift a variable in an expression + ;; context, and try to use it in another nested context outside of + ;; the lifted expression's scope. + #`(let () + (define/contract (id arg) + (-> (or/c pred-id ...) any) + (cond + [(pred-id arg) (f-id arg)] + ...)) + id))])) ;; The only case-dispatch macro (all others are renamings of this one) (define-syntax the-case-dispatch the-case-dispatch-impl) diff --git a/scribblings/polysemy.scrbl b/scribblings/polysemy.scrbl index 2292381..bb82480 100644 --- a/scribblings/polysemy.scrbl +++ b/scribblings/polysemy.scrbl @@ -1,5 +1,9 @@ #lang scribble/manual -@(require (for-label racket/base +@(require scribble/example + (for-label racket/base + racket/contract/base + racket/match + syntax/parse polysemy)) @title{Polysemy: support for polysemic identifiers} @@ -13,6 +17,110 @@ other racketeers. The bindings described here may be changed in future versions without notice. +@section{Examples} + +This first example shows four short modules which all define the identifier +@racketid[^], with four different meanings: the first uses it as a special +token (similarly to the use of @racket[:] to separate fields from their type +in Typed Racket, among other things); the second defines it as a exclusive-or +match expander; the third defines it as the exponentiation function; the +fourth defines it as the two-variable logical xor function (which, thankfully, +does not need any short-circuiting behaviour). + +@examples[#:escape UNSYNTAX + (module m-one racket + (require polysemy (for-syntax syntax/parse racket/list)) + (provide (poly-out [my-macro normal-macro] + [^ my-macro-repeat-n-times])) + (define-poly-literal ^ my-macro-repeat-n-times hat-stxclass) + (define-poly my-macro normal-macro + (syntax-parser + [(_ v :hat-stxclass n) + #`(list . #,(for/list ([i (in-range (syntax-e #'n))]) #'v))]))) + (module m-two racket + (require polysemy (for-syntax syntax/parse)) + (provide (poly-out [[xor ^] match-expander])) + (define-poly xor match-expander + (syntax-parser + [(_ a b) #'(and (or a b) (not (and a b)))]))) + (module m-three racket + (require polysemy) + (provide (all-defined-out)) + (code:comment "Multi-argument functions are not supported yet…") + (define-poly-case (^ [x number?]) (λ (y) (expt x y)))) + (module m-four racket + (require polysemy) + (provide (all-defined-out)) + (define-poly-case (^ [x boolean?]) + (λ (y) + (and (or x y) (not (and x y)))))) + (code:comment "Seamlessly require the two versions of ^") + (require 'm-one 'm-two 'm-three 'm-four racket/match) + + (my-macro 'foo ^ 3) + (match "abc" + [(^ (regexp #px"a") (regexp #px"b")) "a xor b but not both"] + [_ "a and b, or neither"]) + ((^ 2) 3) + ((^ #t) #f)] + +Thanks to the use of @racketmodname[polysemy], all four uses are compatible, +and it is possible to require the four modules without any special incantation +at the require site. The providing modules themselves have to use special +incantations, though: @racket[define-poly-literal], @racket[define-poly] and +@racket[define-poly-case]. Furthermore, a simple @racket[rename-out] does not +cut it anymore, and it is necessary to use @racket[poly-out] to rename +provided polysemic identifiers. Note that a static check is performed, to make +sure that the cases handled by @racketid[^] from @racketid[m-three] do not +overlap the cases handled by @racketid[^] from @racketid[m-four]. The function +overloads are, in this sense, safe. + +The following example shows of the renaming capabilities of +@racketmodname[polysemy]: three meanings for the @racket[foo] identifier are +defined in two separate modules (two meanings in the first, one in the +second). The meanings of @racketid[foo] from the first module are split apart +into the identifiers @racketid[baz] and @racketid[quux], and the meaning from +the second module is attached to @racketid[baz]. The identifier @racketid[baz] +is therefore a chimera, built with half of the @racketid[foo] from the first +module, and the @racketid[foo] from the second module. + +@examples[(module ma racket + (require polysemy) + (provide (all-defined-out)) + (define-poly foo match-expander (λ (stx) #'(list _ "foo" "match"))) + (define-poly-case (foo [x integer?]) (add1 x))) + (module mb racket + (require polysemy) + (provide (all-defined-out)) + (define-poly-case (foo [x list?]) (length x))) + + (code:comment "baz is a hybrid of the foo match expander from ma,") + (code:comment "and of the foo function on lists from mb.") + (code:comment "ma's foo function is separately renamed to quux.") + (require polysemy + racket/match + (poly-rename-in 'ma + [[foo baz] match-expander] + [[foo quux] (case-function integer?)]) + (poly-rename-in 'mb + [[foo baz] (case-function list?)])) + + (code:comment "baz now is a match expander and function on lists:") + (match '(_ "foo" "match") [(baz) 'yes]) + (baz '(a b c d)) + + (code:comment "The baz function does not accept integers") + (code:comment "(the integer-function part from ma was split off)") + (eval:error (baz 42)) + + (code:comment "The quux function works on integers…") + (quux 42) + (code:comment "… but not on lists, and it is not a match expander") + (eval:error (quux '(a b c d))) + (eval:error (match '(_ "foo" "match") [(quux) 'yes] [_ 'no]))] + +@section{Introduction} + This module allows defining polysemic identifiers which can act as a @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{match expander}, as a @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{macro}, as an @@ -36,6 +144,8 @@ The following meanings are special: @item{Other "core" meanings may be added later, and third-party libraries can define their own meanings.}] +@section{Bindings provided by @racketmodname[polysemy]} + In all the forms below, the @racket[_meaning] should be a simple identifier. Note that is lexical context is not taken into account (i.e. the comparison is based on the equality of symbols, not based on @racket[free-identifier=?]), @@ -103,7 +213,7 @@ themselves to be renamed, to circumvent conflicts). default name, without the risk of the identifiers conflicting. Furthermore, it is possible to rename the two meanings separately.} -@defform[(define-poly-case (name [arg₀ pred?] argᵢ ...) . body)]{ +@defform[(define-poly-case (name [arg₀ pred?]) . body)]{ Note that the syntax for this form will be changed in the future when support for multiple-argument dispatch is added (remember, this package is still in an experimental state). @@ -119,11 +229,60 @@ themselves to be renamed, to circumvent conflicts). @item[@racket[integer?]] @item[@racket[exact?]] @item[@racket[number?]] - @item[@racket[zero?]]] + @item[@racket[zero?]] + @item[@racket[list?]]] When any polysemic identifier which is contains a poly-case is called as a function, a check is performed to make sure that none of its cases overlap. If some cases overlap, then an error is raised. Note that an identifier cannot have both a meaning as a function case, and a - @racket[normal-macro] or @racket[identifier-macro] meanings.} \ No newline at end of file + @racket[normal-macro] or @racket[identifier-macro] meanings.} + +@defform[#:kind "poly-meaning-expander" + (case-function pred?)]{ + When used in place of a meaning in a @racket[poly-rename-in], + @racket[poly-only-in] or @racket[poly-out] form, expands to the meaning symbol + for a function overload accepting the given argument type. The + @racket[normal-macro] and @racket[identifier-macro] meanings (which would + normally be associated with @racketmodname[polysemic]'s dynamic dispatch + macro) are also included in the expansion.} + +@defidform[#:kind "meaning" + poly-meaning-expander]{ + + When used as + @racket[(define-poly _some-id poly-meaning-expander (λ (stx) . body))], + defines an expander for the @racket[poly-rename-in], @racket[poly-only-in] and + @racket[poly-out] forms. For example, the @racket[case-function] expander + described above is defined in that way. + +} + +@section{Limitations} + +There are currently many limitations. Here are a few: + +@itemlist[ + @item{Meanings themselves cannot be renamed, and must therefore be globally + unique. A later version could solve this by generating the actual meaning + symbol using @racket[gensym], and by attaching it to a user-friendly name by + means of a @racket[poly-meaning-expander].} + @item{It should be possible to specify multiple macro cases, as long as they + do not overlap.} + @item{Function overloads currently only allow a single argument. Adding + multiple dispatch and multiple non-dispatch arguments would be nice.} + @item{Only a few contracts are supported by function overloads. For simple + contracts, it is only a matter of extending the inheritance table in + @filepath{ids.rkt}. More complex contract combinators will require a bit more + work.} + @item{The generated functions are not compatible with Typed Racket. Deriving + types from the small set of contracts that we support should not be difficult, + and would allow function overloads in Typed Racket (as long as the + user-defined functions are typed, of course).} + @item{The whole contraption relies on marshalling names. Since + @racket[require] and @racket[provide] only care about plain names, and do not + have a notion of scopes (which could be used to hide some of these names), I + do not see any way to avoid this problem, while still making simple imports + (i.e. without renaming) work seamlessly with the stock implementation of + @racket[require].}] \ No newline at end of file