More documentation, fixed some bugs.

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

main.rkt

@@ -1,121 +1,19 @@
 #lang racket/base
 
-(provide
+;; The provide form is at the bottom of the file, as it needs to use some
- ;; A require transformer
+;; provide transformers defined within this file.
- 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)
 
 (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/contract)
-                     racket/syntax)
          (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]))

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
+    (with-handlers ([(λ (e)
-     #`(begin-for-syntax
+                       (and exn:fail:contract?
-         (register-meanings-end '#,syms)))))
+                            (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
+       ;; TODO: use syntax-local-lift-expression to cache
-       ;;       the generated dispatch functions.
+       ;;       the generated dispatch functions. Beware of all the failure
-       #`(λ (arg)
+       ;;       modes: it is very easy to lift a variable in an expression
-           (cond
+       ;;       context, and try to use it in another nested context outside of
-             [(pred-id arg) (f-id arg)]
+       ;;       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)

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.}
+ @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].}]