commit 93d9fc03334a7d84d65be145b85b9c7864f4825e
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Thu, 27 Apr 2017 23:26:09 +0200
Squashed commits
Diffstat:
10 files changed, 993 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,6 @@
+*~
+\#*
+.\#*
+.DS_Store
+compiled/
+/doc/
diff --git a/.travis.yml b/.travis.yml
@@ -0,0 +1,31 @@
+language: c
+sudo: false
+
+env:
+ global:
+ # RACKET_DIR is an argument to install-racket.sh
+ - RACKET_DIR=~/racket
+ - PATH="$RACKET_DIR/bin:$PATH"
+ matrix:
+ # RACKET_VERSION is an argument to install-racket.sh
+ - RACKET_VERSION=6.5
+ - RACKET_VERSION=6.6
+ - RACKET_VERSION=6.7
+ - RACKET_VERSION=6.8
+ - RACKET_VERSION=RELEASE
+ - RACKET_VERSION=HEAD
+
+before_install:
+- curl -L https://raw.githubusercontent.com/greghendershott/travis-racket/master/install-racket.sh | bash
+- raco pkg install --deps search-auto doc-coverage cover cover-codecov # or cover-coveralls
+
+install:
+- raco pkg install --deps search-auto -j 2
+
+script:
+- raco test -x -p "$(basename "$TRAVIS_BUILD_DIR")"
+- raco setup --check-pkg-deps --no-zo --no-launcher --no-install --no-post-install --no-docs --pkgs "$(basename "$TRAVIS_BUILD_DIR")"
+- raco doc-coverage "$(basename "$TRAVIS_BUILD_DIR")"
+- raco cover -s main -s test -s doc -f codecov -f html -d ~/coverage . || true
+# TODO: add an option to cover to run the "outer" module too, not just the submodules.
+# TODO: deploy the coverage info.
+\ No newline at end of file
diff --git a/LICENSE-more.md b/LICENSE-more.md
@@ -0,0 +1,28 @@
+multi-id
+
+Parts of this this software were initially written as part of a project
+at Cortus, S.A.S. which can be reached at 97 Rue de Freyr, 34000
+Montpellier, France. I got their permission to redistribute the code in
+the Public Domain.
+
+
+
+This package is in distributed under the Creative Commons CC0 license
+https://creativecommons.org/publicdomain/zero/1.0/, as specified by
+the LICENSE.txt file.
+
+
+
+The CC0 license is equivalent to a dedication to the Public Domain
+in most countries, but is also effective in countries which do not
+recognize explicit dedications to the Public Domain.
+
+
+
+In order to avoid any potential licensing issues, this package is explicitly
+distributed under the Creative Commons CC0 license
+https://creativecommons.org/publicdomain/zero/1.0/, or under the GNU Lesser
+General Public License (LGPL) https://opensource.org/licenses/LGPL-3.0, or
+under the Apache License Version 2.0
+https://opensource.org/licenses/Apache-2.0, or under the MIT license
+https://opensource.org/licenses/MIT, at your option.
diff --git a/LICENSE.txt b/LICENSE.txt
@@ -0,0 +1,116 @@
+CC0 1.0 Universal
+
+Statement of Purpose
+
+The laws of most jurisdictions throughout the world automatically confer
+exclusive Copyright and Related Rights (defined below) upon the creator and
+subsequent owner(s) (each and all, an "owner") of an original work of
+authorship and/or a database (each, a "Work").
+
+Certain owners wish to permanently relinquish those rights to a Work for the
+purpose of contributing to a commons of creative, cultural and scientific
+works ("Commons") that the public can reliably and without fear of later
+claims of infringement build upon, modify, incorporate in other works, reuse
+and redistribute as freely as possible in any form whatsoever and for any
+purposes, including without limitation commercial purposes. These owners may
+contribute to the Commons to promote the ideal of a free culture and the
+further production of creative, cultural and scientific works, or to gain
+reputation or greater distribution for their Work in part through the use and
+efforts of others.
+
+For these and/or other purposes and motivations, and without any expectation
+of additional consideration or compensation, the person associating CC0 with a
+Work (the "Affirmer"), to the extent that he or she is an owner of Copyright
+and Related Rights in the Work, voluntarily elects to apply CC0 to the Work
+and publicly distribute the Work under its terms, with knowledge of his or her
+Copyright and Related Rights in the Work and the meaning and intended legal
+effect of CC0 on those rights.
+
+1. Copyright and Related Rights. A Work made available under CC0 may be
+protected by copyright and related or neighboring rights ("Copyright and
+Related Rights"). Copyright and Related Rights include, but are not limited
+to, the following:
+
+ i. the right to reproduce, adapt, distribute, perform, display, communicate,
+ and translate a Work;
+
+ ii. moral rights retained by the original author(s) and/or performer(s);
+
+ iii. publicity and privacy rights pertaining to a person's image or likeness
+ depicted in a Work;
+
+ iv. rights protecting against unfair competition in regards to a Work,
+ subject to the limitations in paragraph 4(a), below;
+
+ v. rights protecting the extraction, dissemination, use and reuse of data in
+ a Work;
+
+ vi. database rights (such as those arising under Directive 96/9/EC of the
+ European Parliament and of the Council of 11 March 1996 on the legal
+ protection of databases, and under any national implementation thereof,
+ including any amended or successor version of such directive); and
+
+ vii. other similar, equivalent or corresponding rights throughout the world
+ based on applicable law or treaty, and any national implementations thereof.
+
+2. Waiver. To the greatest extent permitted by, but not in contravention of,
+applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and
+unconditionally waives, abandons, and surrenders all of Affirmer's Copyright
+and Related Rights and associated claims and causes of action, whether now
+known or unknown (including existing as well as future claims and causes of
+action), in the Work (i) in all territories worldwide, (ii) for the maximum
+duration provided by applicable law or treaty (including future time
+extensions), (iii) in any current or future medium and for any number of
+copies, and (iv) for any purpose whatsoever, including without limitation
+commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes
+the Waiver for the benefit of each member of the public at large and to the
+detriment of Affirmer's heirs and successors, fully intending that such Waiver
+shall not be subject to revocation, rescission, cancellation, termination, or
+any other legal or equitable action to disrupt the quiet enjoyment of the Work
+by the public as contemplated by Affirmer's express Statement of Purpose.
+
+3. Public License Fallback. Should any part of the Waiver for any reason be
+judged legally invalid or ineffective under applicable law, then the Waiver
+shall be preserved to the maximum extent permitted taking into account
+Affirmer's express Statement of Purpose. In addition, to the extent the Waiver
+is so judged Affirmer hereby grants to each affected person a royalty-free,
+non transferable, non sublicensable, non exclusive, irrevocable and
+unconditional license to exercise Affirmer's Copyright and Related Rights in
+the Work (i) in all territories worldwide, (ii) for the maximum duration
+provided by applicable law or treaty (including future time extensions), (iii)
+in any current or future medium and for any number of copies, and (iv) for any
+purpose whatsoever, including without limitation commercial, advertising or
+promotional purposes (the "License"). The License shall be deemed effective as
+of the date CC0 was applied by Affirmer to the Work. Should any part of the
+License for any reason be judged legally invalid or ineffective under
+applicable law, such partial invalidity or ineffectiveness shall not
+invalidate the remainder of the License, and in such case Affirmer hereby
+affirms that he or she will not (i) exercise any of his or her remaining
+Copyright and Related Rights in the Work or (ii) assert any associated claims
+and causes of action with respect to the Work, in either case contrary to
+Affirmer's express Statement of Purpose.
+
+4. Limitations and Disclaimers.
+
+ a. No trademark or patent rights held by Affirmer are waived, abandoned,
+ surrendered, licensed or otherwise affected by this document.
+
+ b. Affirmer offers the Work as-is and makes no representations or warranties
+ of any kind concerning the Work, express, implied, statutory or otherwise,
+ including without limitation warranties of title, merchantability, fitness
+ for a particular purpose, non infringement, or the absence of latent or
+ other defects, accuracy, or the present or absence of errors, whether or not
+ discoverable, all to the greatest extent permissible under applicable law.
+
+ c. Affirmer disclaims responsibility for clearing rights of other persons
+ that may apply to the Work or any use thereof, including without limitation
+ any person's Copyright and Related Rights in the Work. Further, Affirmer
+ disclaims responsibility for obtaining any necessary consents, permissions
+ or other rights required for any use of the Work.
+
+ d. Affirmer understands and acknowledges that Creative Commons is not a
+ party to this document and has no duty or obligation with respect to this
+ CC0 or use of the Work.
+
+For more information, please see
+<http://creativecommons.org/publicdomain/zero/1.0/>
diff --git a/README.md b/README.md
@@ -0,0 +1,28 @@
+[](https://travis-ci.org/jsmaniac/multi-id)
+[](https://codecov.io/gh/jsmaniac/multi-id)
+[](http://jsmaniac.github.io/travis-stats/#jsmaniac/multi-id)
+[](http://docs.racket-lang.org/multi-id/)
+[](https://github.com/jsmaniac/multi-id/issues)
+[](https://creativecommons.org/publicdomain/zero/1.0/)
+
+
+multi-id
+========
+
+This package helps defining identifiers with many different meanings in
+different contexts. An identifier can be given a meaning:
+
+* As a [type expander](http://github.com/jsmaniac/type-expander) `(: foo (Listof (ident arg …)))`
+* As a match expander
+* As a called function
+* As a simple identifier (i.e. used as a variable)
+* As a `set!` subform
+
+Installation
+------------
+
+Install with:
+
+```
+raco pkg install --deps search-auto multi-id
+```
diff --git a/info.rkt b/info.rkt
@@ -0,0 +1,19 @@
+#lang info
+(define collection "multi-id")
+(define deps '("base"
+ "rackunit-lib"
+ "typed-racket-lib"
+ "typed-racket-more"
+ "phc-toolkit"
+ "type-expander"
+ "scribble-lib"
+ "hyper-literate"))
+(define build-deps '("scribble-lib"
+ "racket-doc"
+ "scribble-enhanced"
+ "typed-racket-doc"))
+(define scribblings '(("scribblings/multi-id.scrbl" ())
+ ("multi-id.hl.rkt" () (omit-start))))
+(define pkg-desc "Description Here")
+(define version "0.9")
+(define pkg-authors '(|Georges Dupéron|))
diff --git a/main.rkt b/main.rkt
@@ -0,0 +1,4 @@
+#lang typed/racket
+
+(require "multi-id.hl.rkt")
+(provide (all-from-out "multi-id.hl.rkt"))
+\ No newline at end of file
diff --git a/multi-id.hl.rkt b/multi-id.hl.rkt
@@ -0,0 +1,449 @@
+#lang hyper-literate racket/base #:no-require-lang #:no-auto-require
+@(require scribble-enhanced/doc
+ racket/require
+ (for-label (subtract-in typed/racket/base type-expander)
+ type-expander
+ phc-toolkit
+ (subtract-in racket/syntax phc-toolkit)
+ phc-toolkit/untyped-only
+ syntax/parse
+ syntax/parse/experimental/template
+ (only-in type-expander prop:type-expander)))
+@doc-lib-setup
+
+@title[#:style manual-doc-style
+ #:tag "remember"
+ #:tag-prefix "(lib multi-id/multi-id.hl.rkt)"
+ ]{Implementation of the
+ @racket[multi-id] library}
+
+@(chunks-toc-prefix
+ '("(lib multi-id/multi-id.hl.rkt)"))
+
+@author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]]
+
+This document describes the implementation of the
+@racketmodname[multi-id] library, using literate
+programming. For the library's documentation, see the
+@other-doc['(lib "multi-id/scribblings/multi-id.scrbl")]
+document instead.
+
+@section{Syntax properties implemented by the defined @racket[multi-id]}
+
+@chunk[#:save-as prop-te <props>
+ (?? (?@ #:property prop:type-expander p-type))]
+
+@chunk[#:save-as prop-me <props>
+ (?? (?@ #:property prop:match-expander p-match))
+ (?? (?@ #:property prop:match-expander
+ (λ (stx) (syntax-case stx ()
+ [(_ . rest) #'(p-match-id . rest)]))))]
+
+@chunk[#:save-as prop-cw <props>
+ (?? (?@ #:property prop:custom-write p-write))]
+
+@chunk[#:save-as prop-set! <props>
+ #:property prop:set!-transformer
+ (?? p-set!
+ (λ (_ stx)
+ (syntax-case stx (set!)
+ [(set! self . rest) (?? p-set! <fail-set!>)]
+ (?? [(_ . rest) p-just-call])
+ (?? [_ p-just-id]))))]
+
+@chunk[#:save-as maybe-define-type-noexpand <maybe-define-type>
+ (?? (tr:define-type name p-type-noexpand #:omit-define-syntaxes))]
+
+@chunk[#:save-as maybe-define-type-expand-once <maybe-define-type>
+ (?? (define-type name p-type-expand-once #:omit-define-syntaxes))]
+
+@chunk[#:save-as prop-fallback <props>
+ (?@ #:property fallback.prop fallback-value)
+ …]
+
+@(module orig racket/base
+ (require scribble/manual
+ (for-label typed/racket/base))
+ (define orig:tr:define-type @racket[define-type])
+ (provide orig:tr:define-type))
+@(require 'orig)
+
+The multi-id macro defines the identifier @tc[_name] as a
+struct with several properties:
+@itemlist[
+ @item{@racket[prop:type-expander], so that the identifier
+ acts as a
+ @tech[#:doc '(lib "type-expander/scribblings/type-expander.scrbl")]{
+ type expander}
+
+ @(prop-te)
+
+ Optionally, the user can request the type to not be
+ expanded, in which case we bind the type expression to a
+ temporary type name, using the original
+ @orig:tr:define-type from @racketmodname[typed/racket]:
+
+ @(maybe-define-type-noexpand)
+
+ The user can otherwise request that the type expression be
+ expanded once and for all. This can be used for
+ performance reasons, to cache the expanded type, instead
+ of re-computing it each time the @racket[name] identifier
+ is used as a type. To achieve that, we bind the expanded
+ type to a temporary type name using @racket[define-type]
+ as provided by the @racketmodname[type-expander] library:
+
+ @(maybe-define-type-expand-once)
+
+ The two keywords @racket[#:type-noexpand] and
+ @racket[#:type-expand-once] can also be used to circumvent
+ issues with recursive types (the type expander would
+ otherwise go in an infinite loop while attempting to
+ expand them). This behaviour may be fixed in the future,
+ but these options should stay so that they can still be
+ used for performance reasons.}
+
+ @item{@racket[prop:match-expander], so that the identifier
+ acts as a
+ @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{
+ match expander}
+
+ @(prop-me)}
+
+ @item{@racket[prop:custom-write], so that the identifier
+ can be printed in a special way. Note that this does not
+ affect instances of the data structure defined using
+ multi-id. It is even possible that this property has no
+ effect, as no instances of the structure should ever be
+ created, in practice. This feature is therefore likely to
+ change in the future.
+
+ @(prop-cw)}
+
+ @item{@racket[prop:set!-transformer], so that the
+ identifier can act as a regular
+ @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{macro},
+ as an
+ @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro}
+ and as a
+ @seclink["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")]{
+ set! transformer}.
+
+ @(prop-set!)}
+
+ @item{Any @racket[prop:xxx] identifier can be defined with @racket[#:xxx], if
+ so long as the @racket[prop:xxx] identifier is a
+ @racket[struct-type-property?].
+
+ @(prop-fallback)}]
+
+The multi-id macro therefore defines @racket[_name] as follows:
+
+@chunk[<multi-id-body>
+ (template
+ (begin
+ <maybe-define-type>
+ (define-syntax name
+ (let ()
+ (struct tmp ()
+ <props>)
+ (tmp)))))]
+
+@section{Signature of the @racket[multi-id] macro}
+
+
+@chunk[#:save-as type-expander-kws <type-expander-kws>
+ (~optional (~or (~seq #:type-expander p-type:expr)
+ (~seq #:type-noexpand p-type-noexpand:expr)
+ (~seq #:type-expand-once p-type-expand-once:expr)))]
+
+@chunk[#:save-as match-expander-kws <match-expander-kws>
+ (~optional (~or (~seq #:match-expander p-match:expr)
+ (~seq #:match-expander-id p-match-id:id)))]
+
+@chunk[#:save-as custom-write-kw <custom-write-kw>
+ (~optional (~seq #:custom-write p-write:expr))]
+
+@chunk[#:save-as set!-transformer-kws <set!-transformer-kws>
+ (~optional (~or (~seq #:set!-transformer p-set!:expr)
+ :kw-else
+ :kw-set!+call+id))]
+
+@; TODO: maybe we should cache @tc[p-else] and @tc[p-get].
+
+@CHUNK[#:save-as stx-class-kw-else <stx-class-kw-else>
+ (define-splicing-syntax-class kw-else
+ #:attributes (p-just-set! p-just-call p-just-id)
+ (pattern (~seq #:mutable-else p-else)
+ #:with p-just-set! #'#'(set! p-else . rest)
+ #:with p-just-call #'#'(p-else . rest)
+ #:with p-just-id #'#'p-else)
+ (pattern (~seq #:else p-else)
+ #:with p-just-set! <fail-set!>
+ #:with p-just-call #'#`(#,p-else . rest)
+ #:with p-just-id #'p-else)
+ (pattern (~seq #:mutable-else-id p-else-id)
+ #:with (:kw-else) #'(#:mutable-else #'p-else-id))
+ (pattern (~seq #:else-id p-else-id)
+ #:with (:kw-else) #'(#:else #'p-else-id)))]
+
+@; TODO: add #:pattern-expander with prop:pattern-expander, see
+@; http://docs.racket-lang.org/syntax/stxparse-patterns.html
+@; #%28def._%28%28lib._syntax%2Fparse..rkt%29._prop~3apattern-expander%29%29
+@chunk[#:save-as stx-class-kw-set!+call+id <stx-class-kw-set!+call+id>
+ (define-splicing-syntax-class kw-set!+call+id
+ (pattern (~seq (~or
+ (~optional (~seq #:set! p-user-set!:expr))
+ (~optional (~or (~seq #:call p-user-call:expr)
+ (~seq #:call-id p-user-call-id:id)))
+ (~optional (~or (~seq #:id p-user-id:expr)
+ (~seq #:id-id p-user-id-id:expr))))
+ …)
+ #:attr p-just-set!
+ (and (attribute p-user-set!) #'(p-user-set! stx))
+ #:attr p-just-call
+ (cond [(attribute p-user-call)
+ #'(p-user-call stx)]
+ [(attribute p-user-call-id)
+ #'(syntax-case stx ()
+ [(_ . rest) #'(p-user-call-id . rest)])]
+ [else #f])
+ #:attr p-just-id
+ (cond [(attribute p-user-id) #'(p-user-id stx)]
+ [(attribute p-user-id-id) #'#'p-user-id-id]
+ [else #f])))]
+
+@chunk[#:save-as fail-set! <fail-set!>
+ #'(raise-syntax-error
+ 'self
+ (format "can't set ~a" (syntax->datum #'self)))]
+@chunk[#:save-as prop-keyword <prop-keyword-syntax-class>
+ (define-syntax-class prop-keyword
+ (pattern keyword:keyword
+ #:with prop (datum->syntax #'keyword
+ (string->symbol
+ (string-append
+ "prop:"
+ (keyword->string
+ (syntax-e #'keyword))))
+ #'keyword
+ #'keyword)
+ #:when (eval #'(struct-type-property? prop))))]
+
+@chunk[#:save-as fallback-kw <fallback-kw>
+ (~seq fallback:prop-keyword fallback-value:expr)]
+
+The @tc[multi-id] macros supports many options, although
+not all combinations are legal. The groups of options
+specify how the @racket[_name] identifier behaves as a type
+expander, match expander, how it is printed with
+@racket[prop:custom-write] and how it acts as a
+@racket[prop:set!-transformer], which covers usage as a
+macro, identifier macro and actual @racket[set!]
+transformer.
+
+@chunk[<multi-id>
+ (begin-for-syntax
+ <stx-class-kw-else>
+ <stx-class-kw-set!+call+id>
+ <prop-keyword-syntax-class>)
+ (define-syntax/parse (define-multi-id name:id
+ (~or <type-expander-kws>
+ <match-expander-kws>
+ <custom-write-kw>
+ <set!-transformer-kws>
+ <fallback-kw>)
+ …)
+ <multi-id-body>)]
+
+These groups of options are detailed below:
+
+@itemlist[
+ @item{The @racket[#:type-expander],
+ @racket[#:type-noexpand] and @racket[#:type-expand-once]
+ options are mutually exclusive.
+
+ @(type-expander-kws)}
+
+ @item{The @racket[#:match-expander] and @racket[#:match-expander-id]
+ options are mutually exclusive.
+
+ @(match-expander-kws)}
+
+ @item{The @racket[#:custom-write] keyword can always be used
+
+ @(custom-write-kw)}
+
+ @item{The @racket[prop:set!-transformer] can be specified
+ as a whole using @racket[#:set!-transformer], or using one
+ of @racket[#:else], @racket[#:else-id],
+ @racket[#:mutable-else] or @racket[#:mutable-else-id], or
+ using some combination of @racket[#:set!],
+ @racket[#:call] (or @racket[#:call-id]) and
+ @racket[#:id].
+
+ @(set!-transformer-kws)
+
+ More precisely, the @racket[kw-else] syntax class accepts
+ one of the mutually exclusive options @racket[#:else],
+ @racket[#:else-id], @racket[#:mutable-else] and
+ @racket[#:mutable-else-id]:
+
+ @(stx-class-kw-else)
+
+ The @racket[kw-set!+call+id] syntax class accepts
+ optionally the @racket[#:set!] keyword, optionally one of
+ @racket[#:call] or @racket[#:call-id], and optionally the
+ @racket[#:id] keyword.
+
+ @(stx-class-kw-set!+call+id)
+
+ When neither the @racket[#:set!] option nor
+ @racket[#:set!-transformer] are given, the @racket[_name]
+ identifier acts as an immutable object, and
+ cannot be used in a @racket[set!] form. If it appears as
+ the second element of a @racket[set!] form, it raises a
+ syntax error:
+
+ @(fail-set!)}
+
+ @item{As a fallback, for any @racket[#:xxx] keyword, we check whether a
+ corresponding @racket[prop:xxx] exists, and whether it is a
+ @racket[struct-type-property?]:
+
+ @(fallback-kw)
+
+ The check is implemented as a syntax class:
+
+ @(prop-keyword)}]
+
+@section{Tests for @racket[multi-id]}
+
+@chunk[<test-multi-id>
+ (define (p1 [x : Number]) (+ x 1))
+
+ (define-type-expander (Repeat stx)
+ (syntax-case stx ()
+ [(_ t n) #`(List #,@(map (λ (x) #'t)
+ (range (syntax->datum #'n))))]))
+
+ (define-multi-id foo
+ #:type-expander
+ (λ (stx) #'(List (Repeat Number 3) 'x))
+ #:match-expander
+ (λ (stx) #'(vector _ _ _))
+ #:custom-write
+ (λ (self port mode) (display "custom-write for foo" port))
+ #:set!-transformer
+ (λ (_ stx)
+ (syntax-case stx (set!)
+ [(set! self . _)
+ (raise-syntax-error 'foo (format "can't set ~a"
+ (syntax->datum #'self)))]
+ [(_ . rest) #'(+ . rest)]
+ [_ #'p1])))
+
+ (check-equal? (ann (ann '((1 2 3) x) foo)
+ (List (List Number Number Number) 'x))
+ '((1 2 3) x))
+
+ (code:comment "(set! foo 'bad) should throw an error here")
+
+ (let ([test-match (λ (val) (match val [(foo) #t] [_ #f]))])
+ (check-equal? (test-match #(1 2 3)) #t)
+ (check-equal? (test-match '(1 x)) #f))
+
+ (check-equal? (foo 2 3) 5)
+ (check-equal? (map foo '(1 5 3 4 2)) '(2 6 4 5 3))]
+
+It would be nice to test the @tc[(set! foo 'bad)] case, but grabbing the
+compile-time error is a challenge (one could use @tc[eval], but it's a bit heavy
+to configure).
+
+Test with @tc[#:else]:
+
+@chunk[<test-multi-id>
+ (begin-for-syntax
+ (define-values
+ (prop:awesome-property awesome-property? get-awesome-property)
+ (make-struct-type-property 'awesome-property)))
+
+ (define-multi-id bar-id
+ #:type-expander
+ (λ (stx) #'(List `,(Repeat 'x 2) Number))
+ #:match-expander
+ (λ (stx) #'(cons _ _))
+ #:custom-write
+ (λ (self port mode) (display "custom-write for foo" port))
+ #:else-id p1
+ #:awesome-property 42)
+
+ (check-equal? (ann (ann '((x x) 79) bar)
+ (List (List 'x 'x) Number))
+ '((x x) 79))
+
+ (code:comment "(set! bar 'bad) should throw an error here")
+
+ (let ([test-match (λ (val) (match val [(bar-id) #t] [_ #f]))])
+ (check-equal? (test-match '(a . b)) #t)
+ (check-equal? (test-match #(1 2 3)) #f))
+
+ (let ([f-bar-id bar-id])
+ (check-equal? (f-bar-id 6) 7))
+ (check-equal? (bar-id 6) 7)
+ (check-equal? (map bar-id '(1 5 3 4 2)) '(2 6 4 5 3))
+
+ (require (for-syntax rackunit))
+ (define-syntax (check-awesome-property stx)
+ (syntax-case stx ()
+ [(_ id val)
+ (begin (check-pred awesome-property?
+ (syntax-local-value #'id (λ _ #f)))
+ (check-equal? (get-awesome-property
+ (syntax-local-value #'id (λ _ #f)))
+ (syntax-e #'val))
+ #'(void))]))
+ (check-awesome-property bar-id 42)]
+
+@chunk[<test-multi-id>
+ (define-multi-id bar
+ #:type-expander
+ (λ (stx) #'(List `,(Repeat 'x 2) Number))
+ #:match-expander
+ (λ (stx) #'(cons _ _))
+ #:custom-write
+ (λ (self port mode) (display "custom-write for foo" port))
+ #:else #'p1)
+
+ (check-equal? (ann (ann '((x x) 79) bar)
+ (List (List 'x 'x) Number))
+ '((x x) 79))
+
+ (code:comment "(set! bar 'bad) should throw an error here")
+
+ (let ([test-match (λ (val) (match val [(bar) #t] [_ #f]))])
+ (check-equal? (test-match '(a . b)) #t)
+ (check-equal? (test-match #(1 2 3)) #f))
+
+ (check-equal? (bar 6) 7)
+ (check-equal? (map bar '(1 5 3 4 2)) '(2 6 4 5 3))]
+
+@section{Conclusion}
+
+@chunk[<*>
+ (require (only-in type-expander prop:type-expander define-type)
+ (only-in typed/racket [define-type tr:define-type])
+ phc-toolkit/untyped
+ (for-syntax phc-toolkit/untyped
+ racket/base
+ racket/syntax
+ syntax/parse
+ syntax/parse/experimental/template
+ (only-in type-expander prop:type-expander)))
+ (provide define-multi-id)
+
+ <multi-id>
+
+ (module* test-syntax racket/base
+ (provide tests)
+ (define tests #'(begin <test-multi-id>)))]
diff --git a/scribblings/multi-id.scrbl b/scribblings/multi-id.scrbl
@@ -0,0 +1,293 @@
+#lang scribble/manual
+@require[@for-label[multi-id
+ racket/base
+ racket/contract/base]
+ scribble-enhanced]
+
+@title{Polyvalent identifiers with @racket[multi-id]}
+@author{Georges Dupéron}
+
+@defmodule[multi-id]
+
+This library is implemented using literate programming. The
+implementation details are presented in the
+@other-doc['(lib "multi-id/multi-id.hl.rkt")]
+document.
+
+This package helps defining identifiers with many different meanings in
+different contexts. An identifier can be given a meaning:
+
+@itemlist[
+ @item{As a type expander @racket[(: foo (Listof (ident arg …)))]
+ (see @racketmodname[type-expander #:indirect])}
+ @item{As a @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{
+ match expander}}
+ @item{As a @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{macro}
+ (i.e. when it appears in the first position of a form)}
+ @item{As a simple identifier (i.e. used as a variable, via an
+ @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro})}
+ @item{As a @racket[set!] subform}]
+
+@defform[(define-multi-id name
+ maybe-type-expander
+ maybe-match-expander
+ maybe-maybe-set!+call+id
+ fallback-clause ...)
+ #:grammar ([maybe-type-expander
+ (code:line)
+ (code:line #:type-expander proc)]
+ [maybe-match-expander
+ (code:line)
+ (code:line #:match-expander proc)]
+ [maybe-set!+call+id
+ (code:line)
+ (code:line #:set!-transformer proc)
+ (code:line else)
+ (code:line maybe-set! maybe-call maybe-id)]
+ [maybe-set!
+ (code:line #:set! proc)]
+ [maybe-call
+ (code:line #:call proc)
+ (code:line #:call-id identifier)]
+ [maybe-id
+ (code:line #:id proc)
+ (code:line #:id-id identifier)]
+ [else
+ (code:line #:else-id identifier)
+ (code:line #:mutable-else-id identifier)
+ (code:line #:else identifier-expression)
+ (code:line #:mutable-else identifier-expression)]
+ [fallback-clause
+ (code:line #:??? expression)]
+ [??? "any struct-type-property?, without the prop:"])]{
+ Defines @racket[name] as a
+ @tech[#:doc '(lib "type-expander/scribblings/type-expander.scrbl")]{
+ type expander},
+ @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{
+ match expander},
+ @seclink["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")]{
+ set! transformer},
+ @tech[#:doc '(lib
+"scribblings/guide/guide.scrbl")]{identifier macro}, a
+ regular
+ @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{macro},
+ some other concepts, each implemented with an arbitrary
+ @racket[struct-type-property?],
+ or combinations of those.
+
+ In the syntax described above, each @racket[proc] should
+ be a transformer procedure accepting a single
+ @racket[syntax?] argument and returning a @racket[syntax?]
+ value, i.e. the signature of each @racket[proc] should be
+ @racket[(syntax? . -> . syntax?)]. Each
+ @racket[identifier] should be an identifier, and each
+ @racket[identifier-expression] should be a compile-time
+ expression producing an identifier.
+
+ The following options are currently supported:
+ @specsubform[#:unwrap (#:??? expression)
+ #:grammar
+ ([??? "any struct-type-property?, without the prop:"])]{
+ The identifier @racket[name] is a struct with the @racket[prop:???] struct
+ type property, using the given @racket[_expression]
+
+ In the syntax above, @racket[#:???] is only a placeholder; any keyword can be
+ used, so long as prefixing the keyword's name with @racket[prop:] gives an
+ identifier which is a @racket[struct-type-property?].}
+ @specsubform[#:unwrap (#:type-expander proc)]{ The
+ identifier @racket[name] acts as a
+ @tech[#:doc '(lib "type-expander/scribblings/type-expander.scrbl")]{
+ type expander}, using the given @racket[proc] which
+ should return the syntax for a type.}
+ @specsubform[#:unwrap (#:match-expander proc)]{
+ The identifier @racket[name] acts as a
+ @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{
+ match expander}, using the given @racket[proc] which
+ should return the syntax for a match pattern.}
+ @specsubform[#:unwrap (#:set!-transformer proc)]{
+ The identifier @racket[name] acts as a
+ @seclink["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")]{
+ set! transformer}, using the given @racket[proc] which
+ should return a @racket[syntax?] value. The @racket[proc]
+ is used both when @racket[name] is used in a
+ @racket[set!] form, and when it is used as a macro or
+ identifier macro.}
+ @specsubform[#:unwrap (#:set! proc)]{
+ The identifier @racket[name] acts as a
+ @seclink["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")]{
+ set! transformer} when it is used in a @racket[set!]
+ form, using the given @racket[proc] which should return a
+ @racket[syntax?] value.
+
+ The @racket[proc] is used only when @racket[name] is used
+ in a @racket[set!] form, but not when it is used as a
+ macro or identifier macro. In these cases, @racket[#:call] and
+ @racket[#:id], respectively, are used instead.
+
+ If @racket[#:id] is not specified, but @racket[name] is used
+ as an identifier macro, the @racket[exn:fail:syntax]
+ exception is raised. If @racket[#:call] is not specified,
+ but @racket[name] is used as a regular macro, the
+ @racket[exn:fail:syntax] exception is raised.}
+ @specsubform[#:unwrap (#:call proc)]{
+ The identifier @racket[name]
+ acts as a macro when it appears in the first position of
+ a form, using the given @racket[proc] which should return
+ a @racket[syntax?] value.
+
+ The @racket[proc] is used only when @racket[name] is used
+ as a regular macro, but not when it is used as an
+ identifier macro or when it is used in a @racket[set!]
+ form. In these cases, @racket[#:id] and @racket[#:set!],
+ respectively, are used instead.
+
+ If @racket[#:set!] is not specified, but @racket[name] is
+ used in a @racket[set!] form, the @racket[exn:fail:syntax]
+ exception is raised. If @racket[#:id] is not specified, but
+ @racket[name] is used as an identifier macro, the
+ @racket[exn:fail:syntax] exception is raised.}
+ @specsubform[#:unwrap (#:call-id identifier)]{
+ The identifier @racket[name]
+ acts as a macro when it appears in the first position of a
+ form. The occurrence of @racket[name] is replaced by the
+ given @racket[identifier], which should either be a
+ function or a macro.
+
+ When @racket[name] is used as a macro, i.e. in a form
+ like @racket[(name . args)], the whole form is replaced
+ by @racket[(identifier . args)]. If the identifier is
+ itself a regular macro, then the whole
+ @racket[(identifier . args)] form is expanded.
+
+ The @racket[identifier] is used only when @racket[name]
+ is used as a regular macro, not when it is used as an
+ identifier macro or as a @racket[set!] transformer.
+ In these cases, @racket[#:id] and @racket[#:set!],
+ respectively, are used instead.
+
+ If @racket[#:set!] is not specified, but @racket[name] is
+ used in a @racket[set!] form, the @racket[exn:fail:syntax]
+ exception is raised. If @racket[#:id] is not specified, but
+ @racket[name] is used as an identifier macro, the
+ @racket[exn:fail:syntax] exception is raised.}
+
+ @specsubform[#:unwrap (#:id proc)]{
+ The identifier @racket[name] acts as an
+ @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro},
+ using the given @racket[proc] which should return a
+ @racket[syntax?] value.
+
+ The @racket[proc] is used only when @racket[name] is used
+ as an identifier macro, but not when it appears in the
+ first position of a form, nor when it is used in a
+ @racket[set!] form. In these cases, @racket[#:call] and
+ @racket[#:set!], respectively, are used instead.
+
+ If @racket[#:set!] is not specified, but @racket[name]
+ is used in a @racket[set!] form, the @racket[exn:fail:syntax]
+ exception is raised. If @racket[#:call] is not specified, but
+ @racket[name] is used as a regular macro, the
+ @racket[exn:fail:syntax] exception is raised.}
+
+ @specsubform[#:unwrap (#:id-id proc)]{
+ The identifier @racket[name] acts as an
+ @tech[#:doc '(lib
+"scribblings/guide/guide.scrbl")]{identifier macro}. The
+ occurrence of @racket[name] is replaced by the given
+ @racket[identifier]. If the @racket[identifier] is itself
+ an identifier macro, it is expanded again.
+
+ The @racket[identifier] is used only when @racket[name]
+ is used as an identifier macro, but not when it appears
+ in the first position of a form, nor when it is used in a
+ @racket[set!] form. In these cases, @racket[#:call] and
+ @racket[#:set!], respectively, are used instead.
+
+ If @racket[#:set!] is not specified, but @racket[name] is
+ used in a @racket[set!] form, the @racket[exn:fail:syntax]
+ exception is raised. If @racket[#:call] is not specified,
+ but @racket[name] is used as a regular macro,
+ the @racket[exn:fail:syntax] exception is raised.}
+
+ @specsubform[#:unwrap (#:else-id identifier)]{
+ The identifier @racket[name]
+ acts as a regular macro and as an identifier macro. The
+ occurrence of @racket[name] is replaced by the given
+ @racket[identifier], which should either be a function, or
+ be both a macro and an identifier macro at the same time.
+
+ When @racket[name] is used as an identifier macro, it is
+ replaced by @racket[identifier]. If the
+ @racket[identifier] is itself an identifier macro, then it
+ is expanded.
+
+ When @racket[name] is used as a macro, i.e. in a form
+ like @racket[(name . args)], the whole form is replaced by
+ @racket[(identifier . args)]. If the identifier is itself
+ a regular macro, then the whole
+ @racket[(identifier . args)] form is expanded.
+
+ The @racket[identifier] is not used when @racket[name] is
+ used in a @racket[set!] form, instead the
+ @racket[exn:fail:syntax] exception is raised.}
+
+ @specsubform[#:unwrap (#:mutable-else-id identifier)]{
+ The identifier @racket[name]
+ acts as a regular macro, as an identifier macro and as a
+ @racket[set!] transformer. In all three cases, the
+ occurrence of @racket[name] is replaced by the given
+ @racket[identifier], which should either be a function, or
+ be a macro and an identifier macro and a @racket[set!]
+ transformer at the same time.
+
+ This option works like @racket[#:else-id], except that
+ @racket[name] can also be used in a @racket[set!] form.
+
+ When @racket[name] is used in a @racket[set!] form like
+ @racket[(set! name . vals)], the whole form is replaced
+ by @racket[(set! identifier . vals)]. If the identifier is
+ itself a @racket[set!] transformer, then the whole
+ @racket[(set! identifier . vals)] form is expanded.}
+
+ @specsubform[#:unwrap (#:else identifier-expression)]{
+ The identifier @racket[name]
+ acts as a regular macro and as an identifier macro. The
+ occurrence of @racket[name] is replaced by the result of
+ the compile-time expression
+ @racket[identifier-expression], which should either
+ produce the syntax for a function, or the syntax for an
+ identifier which is both a macro and an identifier macro
+ at the same time.
+
+ It is equivalent to @racket[#:else-id], except that the
+ identifier is not constant, but is instead produced by
+ @racket[identifier-expression]. Note that
+ @racket[identifier-expression] is not a transformer
+ function (it will not be able to access the original
+ syntax). In other words, the compile-time contract for
+ @racket[identifier-expression] is @racket[syntax?], not
+ @racket[(syntax? . -> . syntax?)].
+
+ The @racket[identifier-expression] is not used when
+ @racket[name] is used in a @racket[set!] form, instead the
+ @racket[exn:fail:syntax] exception is raised.}
+
+ @specsubform[#:unwrap (#:mutable-else identifier-expression)]{
+ The identifier @racket[name] acts as a regular macro, as
+ an identifier macro and as a @racket[set!] transformer. In
+ all three cases, the occurrence of @racket[name] is
+ replaced by the result of the compile-time expression
+ @racket[identifier-expression], which should either
+ produce the syntax for a mutable identifier containing a
+ function, or the syntax for an identifier which is a macro
+ and an identifier macro and a @racket[set!] transformer at
+ the same time.
+
+ It is equivalent to @racket[#:mutable-else-id], except
+ that the identifier is not constant, but is instead
+ produced by @racket[identifier-expression]. Note that
+ @racket[identifier-expression] is not a transformer
+ function (it will not be able to access the original
+ syntax). In other words, the compile-time contract for
+ @racket[identifier-expression] is @racket[syntax?], not
+ @racket[(syntax? . -> . syntax?)].}}
+\ No newline at end of file
diff --git a/test/test-multi-id.rkt b/test/test-multi-id.rkt
@@ -0,0 +1,16 @@
+#lang typed/racket
+
+(require multi-id
+ type-expander
+ typed/rackunit
+ (for-syntax racket/list))
+
+;; Inject in this file the tests shown in multi-id.hl.rkt
+(begin
+ (require (for-syntax (submod "../multi-id.hl.rkt" test-syntax)
+ syntax/strip-context))
+
+ (define-syntax (insert-tests stx)
+ (replace-context stx tests))
+
+ (insert-tests))
