suzanne.soy/polysemy
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added documentation

Browse Source
This commit is contained in:
Georges Dupéron 2017-05-09 19:32:46 +02:00
parent eccf84b899
commit a2c817c7cd
2 changed files with 132 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
main.rkt
View File

@ -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 ()

97
scribblings/polysemy.scrbl
View File

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