commit fe80d8c0285b07d78cd80b29b86af398b5eac3d1
parent 13604ee5dbdc151d2489c42833bcf5b44d9d7f45
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 10 May 2017 03:34:07 +0200
More documentation, fixed some bugs.
Diffstat:
| M | info.rkt | | | 4 | ++-- |
| M | main.rkt | | | 245 | +++++++++++++++++++++++++++++++++++++++++++++---------------------------------- |
| M | private/ids.rkt | | | 40 | ++++++++++++++++++++++++++++++---------- |
| M | scribblings/polysemy.scrbl | | | 169 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- |
4 files changed, 335 insertions(+), 123 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
