Added documentation

main.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (provide
- ;; Another require transformer
+ ;; A require transformer
  poly-rename-in
  ;; Another require transformer
  poly-only-in
@@ -57,25 +57,26 @@
 (define-for-syntax (poly-require-transformer req stx)
   (syntax-parse stx
     [(_ mod
-        [old-id:id
+        [{~or {~and :id old-id new-id}
+              (old-id:id new-id:id)}
          meaning:id
-         {~optional new-id:id #:defaults ([new-id #'old-id])}]
+         ...]
         ...)
-     #:with (old-generated-id ...)
+     #:with ((old-generated-id ...) ...)
-     (map gen-id
+     (map (λ (id meanings) (map (λ (meaning) (gen-id id meaning)) meanings))
           (syntax->list #'(old-id ...))
-          (map syntax-e (syntax->list #'(meaning ...))))
+          (map syntax-e (syntax->list #'((meaning ...) ...))))
      #:with (new-generated-id ...)
-     (map gen-id
+     (map (λ (id meanings) (map (λ (meaning) (gen-id id meaning)) meanings))
           (syntax->list #'(new-id ...))
-          (map syntax-e (syntax->list #'(meaning ...))))
+          (map syntax-e (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 ...)))
+     (register-meanings (syntax->datum #'(meaning ... ...)))
      (expand-import
       #`(combine-in
          ;; We always require the same ids, so that multiple requires
@@ -83,7 +84,7 @@
          (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] ...)))]))
+         (#,req mod [old-generated-id new-generated-id] ... ...)))]))
 
 ;; Require transformer which allows renaming parts of polysemic identifiers.
 (define-syntax poly-rename-in
@@ -177,12 +178,7 @@
        (syntax-case stx ()
          [(_ pvar meaning)
           ;; Do we need to (register-meanings #'(meaning)) here? I think not.
-          #'{~and {~var pvar (poly-stxclass 'meaning)}}
+          #'{~and {~var pvar (poly-stxclass 'meaning)}}])))))
-          #;#'{~and {~var pvar id}
-                    {~do (displayln #'pvar)}
-                    {~bind [meaning-pvar
-                            ]}
-                    {~parse #t (not (not (attribute meaning-pvar)))}}])))))
 
 (define-syntax-rule (define-poly-literal initial-id meaning syntax-class)
   (begin
@@ -207,16 +203,27 @@
     [(_ (name [arg₀ pred?] argᵢ ...) . body)
      (let ([meaning (string->symbol
                      (format "~a" `(poly-case ,(syntax-e #'pred?))))])
-       (with-syntax ([generated-name (gen-id #'name meaning)]
+       (with-syntax
-                     [generated-normal-macro (gen-id #'name 'normal-macro)])
+           ([generated-name (gen-id #'name meaning)]
+            [generated-normal-macro (gen-id #'name 'normal-macro)]
+            [generated-identifier-macro (gen-id #'name 'identifier-macro)])
          (register-meanings `(,meaning))
          #`(begin
              (define-poly name)
+             ;; TODO: provide keywords to selectively disable the
+             ;; identifier-macro or normal-macro behaviours. Also check that
+             ;; if identifier-binding does not return #f, it returns a binding
+             ;; for the-case-dispatch, and not for something else.
              #,@(if (identifier-binding #'generated-normal-macro)
                     #'{}
                     #'{(local-require
                         (only-in polysemy
                                  [the-case-dispatch generated-normal-macro]))})
+             #,@(if (identifier-binding #'generated-identifier-macro)
+                    #'{}
+                    #'{(local-require
+                        (only-in polysemy
+                                 [the-case-dispatch generated-identifier-macro]))})
              (define/contract (tmp-f arg₀ argᵢ ...)
                (-> pred? (or/c 'argᵢ any/c) ... any)
                . body)
@@ -230,11 +237,12 @@
   (unless contracts-supertypes
     (set! contracts-supertypes
           (make-free-id-table
-           `((,#'string? . (,#'any/c))
+           `((,#'any/c . ())
+             (,#'string? . (,#'any/c))
              (,#'exact-positive-integer? . (,#'exact-integer? ,#'positive?))
              (,#'exact-integer . (,#'integer? ,#'exact?))
              (,#'integer? . (,#'number?))
-             (,#'exact . (,#'number?)) ;; not quite right
+             (,#'exact? . (,#'number?)) ;; not quite right
              (,#'number? . (,#'any/c))
              (,#'zero? . ,#'integer?)
              #;…))))
@@ -267,17 +275,20 @@
   ;; Move up the inheritance DAG, and see if any of the ancestors
   ;; is covered. Since we start with the parents of the user-supplied contract,
   ;; there will be no self-detection.
+  (define already-recur (mutable-free-id-set))
   (define (recur pred-id)
+    (unless (free-id-set-member? already-recur pred-id)
+      (free-id-set-add! already-recur pred-id)
       (when (free-id-set-member? covered-ids pred-id)
         (raise-syntax-error 'polysemy
                             "some available function cases overlap"
                             stx
                             #f
                             pred-ids))
-    (unless (free-identifier=? pred-id #'any/c)
+      (for-each recur (free-id-table-ref contracts-supertypes pred-id))))
-      (for-each recur (free-id-table-ref contracts-supertypes pred-id '()))))
   (for ([pred-id (in-list pred-ids)])
-    (apply recur (free-id-table-ref contracts-supertypes pred-id))))
+    (apply recur (free-id-table-ref contracts-supertypes
+                                    pred-id))))
 
 (define-for-syntax (the-case-dispatch-impl stx)
   (syntax-case stx ()

scribblings/polysemy.scrbl

@@ -7,3 +7,100 @@
 
 @defmodule[polysemy]
 
+This is an experimental proof of concept, and is not intended to be used in
+production until the potential issues of doing so have been discussed with
+other racketeers.
+
+The bindings described here may be changed in future versions without notice.
+
+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
+@tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro}, as a
+@racket[set!] subform, and as a collection of 
+
+
+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. it is used as a
+symbol), and therefore every @racket[_meaning] should be globally unique.
+Later versions may add a notion of hygiene to meanings (allowing these
+meanings themselves to be renamed, to circumvent conflicts).
+
+@defform[#:kind "require transformer"
+         (poly-only-in module [maybe-rename meaning ...] ...)
+         #:grammar [(maybe-rename old-id
+                                  [old-id new-id])]]{
+ Requires each given @racket[meaning] of the corresponding @racket[old-id]. If
+ @racket[new-id] is supplied, then the meanings are attached to
+ @racket[new-id], otherwise they are attached to @racket[old-id].}
+
+
+@defform[#:kind "require transformer"
+         (poly-rename-in module [maybe-rename meaning] ...)
+         #:grammar [(maybe-rename old-id
+                                  [old-id new-id])]]{
+
+ Similar to @racket[poly-only-in], but all identifiers and meanings which are
+ unaffected are also implicitly required. Note that if some (but not all)
+ meanings of an identifier are renamed, then the old name is not required
+ automatically anymore, and needs to be explicitly required.}
+
+@defform[#:kind "provide transformer"
+         (poly-out module [maybe-rename meaning])
+         #:grammar [(maybe-rename old-id
+                                  [old-id new-id])]]{
+ Provides the given meanings for @racket[id]. It is necessary to provide all
+ the desired meanings explicitly, or use @racket[(provide (all-defined-out))].
+ Simply using @racket[(provide id)] will only provide the base identifier,
+ without any meanings attached to it.
+
+ If @racket[old-id] and @racket[new-id] are supplied, each given
+ @racket[meaning], which must be attached to @racket[old-id], will be
+ re-attached to @racket[new-id].}
+
+@defform*[{(define-poly id)
+           (define-poly id meaning value)}]{
+ The first form declares that @racket[id] is a polysemic identifier, with
+ no special meaning attached to it.
+
+ The second form attaches the phase 1 @racket[value] (i.e. it is a transformer
+ value) to the given @racket[meaning] of the @racket[id].}
+
+@defform[#:kind "pattern expander"
+         (~poly pvar meaning)]{
+ Pattern epander for @racketmodname[syntax/parse], can be used to match against
+ polysemic identifiers, extracting the desired @racket[meaning].
+ 
+ The transformer value for the requested meaning is stored in the
+ @racket[value] attribute.}
+
+@defform[(define-poly-literal id meaning syntax-class)]{
+ Defines @racket[id] as a literal with the given @racket[meaning]. The
+ @racket[syntax-class] is automatically defined to recognise the given
+ @racket[meaning] of @racket[id], even if @racket[id] was renamed and its
+ different meanings split out and recombined into different identifiers.}
+
+@defform[(define-poly-case (name [arg₀ pred?] argᵢ ...) . 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).
+
+ Defines an overload for the @racket[name] function, based on the type of its
+ first argument. For now, only a few contracts are allowed:
+
+ @itemlist[
+ @item[@racket[any/c]]
+ @item[@racket[string?]]
+ @item[@racket[exact-positive-integer?]]
+ @item[@racket[exact-integer]]
+ @item[@racket[integer?]]
+ @item[@racket[exact?]]
+ @item[@racket[number?]]
+ @item[@racket[zero?]]]
+
+ 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.}