commit a2c817c7cd76ca551214682f6751ac039c65173a
parent eccf84b89972f52915e0ae9cc22002d8883c2c24
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Tue, 9 May 2017 19:32:46 +0200
Added documentation
Diffstat:
| M | main.rkt | | | 59 | +++++++++++++++++++++++++++++++++++------------------------ |
| M | scribblings/polysemy.scrbl | | | 98 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 133 insertions(+), 24 deletions(-)
diff --git a/main.rkt b/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 ...)
- (map gen-id
+ #:with ((old-generated-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 id}
- {~do (displayln #'pvar)}
- {~bind [meaning-pvar
- ]}
- {~parse #t (not (not (attribute meaning-pvar)))}}])))))
+ #'{~and {~var pvar (poly-stxclass 'meaning)}}])))))
(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)]
- [generated-normal-macro (gen-id #'name 'normal-macro)])
+ (with-syntax
+ ([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)
- (when (free-id-set-member? covered-ids 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 ()
diff --git a/scribblings/polysemy.scrbl b/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.}
+\ No newline at end of file
