Squashed commits.
This commit is contained in:
Georges Dupéron
commit
41f7dc0f50
6
.gitignore
vendored
Normal file
6
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*~
|
||||
\#*
|
||||
.\#*
|
||||
.DS_Store
|
||||
compiled
|
||||
/doc/
|
||||
0
.gitmodules
vendored
Normal file
0
.gitmodules
vendored
Normal file
69
.travis.yml
Normal file
69
.travis.yml
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
language: c
|
||||
|
||||
# Based from: https://github.com/greghendershott/travis-racket
|
||||
|
||||
# Optional: Remove to use Travis CI's older infrastructure.
|
||||
sudo: false
|
||||
|
||||
env:
|
||||
global:
|
||||
# Supply a global RACKET_DIR environment variable. This is where
|
||||
# Racket will be installed. A good idea is to use ~/racket because
|
||||
# that doesn't require sudo to install and is therefore compatible
|
||||
# with Travis CI's newer container infrastructure.
|
||||
- RACKET_DIR=~/racket
|
||||
matrix:
|
||||
# Supply at least one RACKET_VERSION environment variable. This is
|
||||
# used by the install-racket.sh script (run at before_install,
|
||||
# below) to select the version of Racket to download and install.
|
||||
#
|
||||
# Supply more than one RACKET_VERSION (as in the example below) to
|
||||
# create a Travis-CI build matrix to test against multiple Racket
|
||||
# versions.
|
||||
#- RACKET_VERSION=6.0
|
||||
#- RACKET_VERSION=6.1
|
||||
#- RACKET_VERSION=6.1.1
|
||||
# Dependency "custom-load" does not work with 6.2 and 6.3
|
||||
#- RACKET_VERSION=6.2
|
||||
# Collection scribble/example is not available yet in 6.3
|
||||
#- RACKET_VERSION=6.3
|
||||
# Scribble bug in 6.4 which got fixed in 6.5
|
||||
#- RACKET_VERSION=6.4
|
||||
- RACKET_VERSION=6.5
|
||||
- RACKET_VERSION=6.6
|
||||
- RACKET_VERSION=HEAD
|
||||
|
||||
matrix:
|
||||
allow_failures:
|
||||
# No support for https://github.com/user/repo.git#commit-hash in info.rkt "deps"
|
||||
- env: RACKET_VERSION=6.0
|
||||
- env: RACKET_VERSION=6.1
|
||||
- env: RACKET_VERSION=6.1.1
|
||||
- env: RACKET_VERSION=6.2
|
||||
- env: RACKET_VERSION=6.3
|
||||
fast_finish: true
|
||||
|
||||
before_install:
|
||||
- git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket
|
||||
- cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh!
|
||||
- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
|
||||
|
||||
install:
|
||||
- raco pkg install -j 1 --deps search-auto
|
||||
|
||||
before_script:
|
||||
|
||||
# Here supply steps such as raco make, raco test, etc. You can run
|
||||
# `raco pkg install --deps search-auto type-expander` to install any required
|
||||
# packages without it getting stuck on a confirmation prompt.
|
||||
script:
|
||||
- raco test -p type-expander
|
||||
- raco setup --check-pkg-deps --no-zo --no-launcher --no-install --no-post-install --no-docs --pkgs type-expander
|
||||
- raco pkg install --deps search-auto doc-coverage
|
||||
- if $RACKET_VERSION != "6.5" -a $RACKET_VERSION != "6.6"; then raco doc-coverage type-expander; fi
|
||||
|
||||
after_success:
|
||||
- raco pkg install --deps search-auto cover cover-coveralls
|
||||
- raco pkg install --deps search-auto
|
||||
# TODO: raco cover doesn't support having a "-s <empty>" option, to run the entire module in addition to the specified submodules
|
||||
- raco cover -b -s doc -s test -s main -f coveralls -d $TRAVIS_BUILD_DIR/coverage .
|
||||
27
LICENSE
Normal file
27
LICENSE
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
This software was initially written as part of a project at Cortus, S.A.S. which
|
||||
can be reached at 97 Rue de Freyr, 34000 Montpellier, France.
|
||||
|
||||
This software may contain a few pieces of code copied from typed/racket
|
||||
https://github.com/racket/typed-racket (mostly the syntax-parse syntax classes
|
||||
for the various overloaded forms) and is therefore licensed under the
|
||||
GNU Lesser General Public License (LGPL).
|
||||
|
||||
|
||||
This package is distributed under the GNU Lesser General Public
|
||||
License (LGPL). This means that you can link this package into proprietary
|
||||
applications, provided you follow the rules stated in the LGPL. You
|
||||
can also modify this package; if you distribute a modified version,
|
||||
you must distribute it under the terms of the LGPL, which in
|
||||
particular means that you must release the source code for the
|
||||
modified software. See http://www.gnu.org/copyleft/lesser.html
|
||||
for more information.
|
||||
|
||||
under the BSD license, at your option. Both licenses can be found in the
|
||||
`licenses/` folder.
|
||||
|
||||
This double-licensing has been chosen in order to make it possible to integrate
|
||||
the type-expander library with Typed/Racket
|
||||
(https://github.com/racket/typed-racket) and/or Racket
|
||||
(https://github.com/racket/racket), which are both under the LGPL license, as
|
||||
well as integrate the graph library with the Nanopass Compiler Framework
|
||||
(https://github.com/akeep/nanopass-framework), which is under the BSD license.
|
||||
66
README.md
Normal file
66
README.md
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
[](https://travis-ci.org/jsmaniac/type-expander)
|
||||
[](https://coveralls.io/github/jsmaniac/type-expander)
|
||||
[](http://jsmaniac.github.io/travis-stats/#jsmaniac/type-expander)
|
||||
[](http://docs.racket-lang.org/type-expander/)
|
||||
[](https://github.com/jsmaniac/type-expander/issues)
|
||||
|
||||
Type-expander
|
||||
=============
|
||||
|
||||
This project is written for
|
||||
[Typed/Racket](https://docs.racket-lang.org/ts-guide/) using Literate
|
||||
Programming. See the “[Implementation of the type expander
|
||||
library](http://docs.racket-lang.org/type-expander/)” part of the [online
|
||||
documentation](http://docs.racket-lang.org/type-expander/) if you want to dig
|
||||
into the source.
|
||||
|
||||
This library enhances typed/racket with type expanders, which are special
|
||||
macros that can appear where a type would normally be expected, and must
|
||||
expand to a type. Type expanders are to types what match expanders are to
|
||||
match patterns. It is based on Asumu Takikawa's [type
|
||||
expanders](https://github.com/racket/racket/compare/master...takikawa:tr-type-expander)
|
||||
(see also his [original pull request
|
||||
here](https://github.com/racket/racket/pull/604)). Asumu Takikawa's work
|
||||
attempted to integrate type expanders directly into Typed/Racket. This
|
||||
project instead implements type expanders as a library and works without any
|
||||
modification of the core Typed/Racket codebase. This shows the extensibility
|
||||
of Typed/Racket thanks to macros, and could serve as the basis for other
|
||||
projects which need to alter the manner in which Typed/Racket handles types.
|
||||
|
||||
Installation
|
||||
============
|
||||
|
||||
```
|
||||
raco pkg install --deps search-auto type-expander
|
||||
```
|
||||
|
||||
Usage example
|
||||
=============
|
||||
|
||||
The `type-expander` is enabled by simply requiring the `type-expander` module
|
||||
in a `typed/racket` program.
|
||||
|
||||
#lang typed/racket
|
||||
(require type-expander)
|
||||
|
||||
For example, one can write the `(HomogeneousList n t)` type-expander, which
|
||||
expands to the type for a list of `n` elements of type `t`:
|
||||
|
||||
(require (for-syntax syntax/parse racket/list))
|
||||
(define-type-expander (HomogeneousList stx)
|
||||
(syntax-parse stx
|
||||
[(_ t:expr n:nat)
|
||||
#`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax-e #'n))))]))
|
||||
|
||||
It can then be used wherever a regular type is usually expected:
|
||||
|
||||
(: five-strings (→ String (HomogeneousList String 5)))
|
||||
(define (five-strings x)
|
||||
(list x "a" "b" "c" "d"))
|
||||
|
||||
(five-strings "hello")
|
||||
;; => '("hello" "a" "b" "c" "d")
|
||||
|
||||
(ann (five-strings "moon") (HomogeneousList String 5))
|
||||
;; => '("moon" "a" "b" "c" "d")
|
||||
11
base.rkt
Normal file
11
base.rkt
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/require
|
||||
(subtract-in typed/racket/base type-expander)
|
||||
type-expander)
|
||||
|
||||
(provide (all-from-out typed/racket/base
|
||||
type-expander))
|
||||
|
||||
(module reader syntax/module-reader
|
||||
type-expander/lang/main)
|
||||
2
base/lang/reader.rkt
Normal file
2
base/lang/reader.rkt
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(module reader syntax/module-reader
|
||||
type-expander/base)
|
||||
8
dbg.rkt
Normal file
8
dbg.rkt
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
#lang typed/racket
|
||||
(require type-expander
|
||||
(for-syntax racket/list)
|
||||
(for-syntax type-expander/expander
|
||||
typed/rackunit
|
||||
debug-scopes))
|
||||
|
||||
(debug-type-expander #t)
|
||||
11
expander.rkt
Normal file
11
expander.rkt
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
#lang racket
|
||||
(require (submod "type-expander.hl.rkt" expander)
|
||||
(for-template (submod "type-expander.hl.rkt" main))
|
||||
syntax/parse)
|
||||
(provide prop:type-expander
|
||||
expand-type
|
||||
apply-type-expander
|
||||
type
|
||||
stx-type/c
|
||||
type-expand!
|
||||
colon)
|
||||
58
identifiers.rkt
Normal file
58
identifiers.rkt
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
#lang typed/racket
|
||||
|
||||
(require (for-syntax racket/syntax))
|
||||
|
||||
(define-syntax-rule (provide-id id)
|
||||
(begin
|
||||
(define-syntax (id stx)
|
||||
(raise-syntax-error 'id
|
||||
(format "Type expander form “~a” cannot be used as an expression"
|
||||
'id)
|
||||
stx))
|
||||
(provide id)))
|
||||
|
||||
(define-syntax-rule (provide-ids id ...) (begin (provide-id id) ...))
|
||||
|
||||
(provide-ids Let Letrec Λ ...* No-Expand)
|
||||
|
||||
;; Define a mutable implementation for new-:, circumvent the fact that
|
||||
;; typed/racket wraps macros with a contract.
|
||||
;;
|
||||
;; Technique from:
|
||||
;;
|
||||
;; https://github.com/racket/typed-racket/issues/329#issuecomment-205060192
|
||||
|
||||
(define-syntax (provide-mutable-id stx)
|
||||
(syntax-case stx ()
|
||||
[(_ short-id)
|
||||
(with-syntax ([id (format-id #'short-id "new-~a" #'short-id)]
|
||||
[id-set-impl (format-id #'short-id
|
||||
"set-~a-impl!"
|
||||
#'short-id)])
|
||||
#'(begin
|
||||
(provide id id-set-impl)
|
||||
|
||||
(define-for-syntax (id-impl-orig stx)
|
||||
(raise-syntax-error ':
|
||||
(format "Implementation for ~a was not loaded!"
|
||||
'short-id)
|
||||
stx))
|
||||
|
||||
(define-for-syntax id-impl (box id-impl-orig))
|
||||
|
||||
(define-syntax (id stx)
|
||||
((unbox id-impl) stx))
|
||||
|
||||
(define-syntax-rule (id-set-impl impl)
|
||||
(begin-for-syntax
|
||||
(when (eq? (unbox id-impl) id-impl-orig)
|
||||
(set-box! id-impl impl))))))]))
|
||||
|
||||
(define-syntax-rule (provide-mutable-ids id ...)
|
||||
(begin (provide-mutable-id id) ...))
|
||||
|
||||
(provide-mutable-ids :
|
||||
;; The class-related IDs need to also work as types.
|
||||
;field
|
||||
;super-new
|
||||
)
|
||||
25
info.rkt
Normal file
25
info.rkt
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
#lang info
|
||||
(define collection "type-expander")
|
||||
(define deps '("base"
|
||||
"rackunit-lib"
|
||||
"scribble-lib"
|
||||
"typed-racket-lib"
|
||||
"typed-racket-more"
|
||||
"hyper-literate"
|
||||
"auto-syntax-e"
|
||||
"debug-scopes"))
|
||||
(define build-deps '("scribble-lib"
|
||||
"racket-doc"
|
||||
"typed-racket-more"
|
||||
"typed-racket-doc"
|
||||
"scribble-enhanced"
|
||||
;; Just for a link to the library inside the documentation.
|
||||
;; Can be removed and change the link
|
||||
;; in type-expander.hl.rkt to
|
||||
;; http://docs.racket-lang.org/mutable-match-lambda/
|
||||
"mutable-match-lambda"))
|
||||
(define scribblings '(("scribblings/type-expander.scrbl" () ("typed-racket"))
|
||||
("scribblings/type-expander-implementation.scrbl" (multi-page) ("typed-racket"))))
|
||||
(define pkg-desc "Description Here")
|
||||
(define version "1.0")
|
||||
(define pkg-authors '(|Georges Dupéron|))
|
||||
11
lang/main.rkt
Normal file
11
lang/main.rkt
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/require
|
||||
(subtract-in typed/racket type-expander)
|
||||
type-expander)
|
||||
|
||||
(provide (all-from-out typed/racket
|
||||
type-expander))
|
||||
|
||||
(module reader syntax/module-reader
|
||||
type-expander/lang/main)
|
||||
2
lang/reader.rkt
Normal file
2
lang/reader.rkt
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(module reader syntax/module-reader
|
||||
type-expander/lang)
|
||||
19
licenses/bsd.txt
Normal file
19
licenses/bsd.txt
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
Copyright (c) 2000-2015 Dipanwita Sarkar, Andrew W. Keep, R. Kent Dybvig, Oscar Waddell
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a
|
||||
copy of this software and associated documentation files (the "Software"),
|
||||
to deal in the Software without restriction, including without limitation
|
||||
the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
||||
and/or sell copies of the Software, and to permit persons to whom the
|
||||
Software is furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in
|
||||
all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||||
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
DEALINGS IN THE SOFTWARE.
|
||||
165
licenses/lgpl-3.0--license.txt
Normal file
165
licenses/lgpl-3.0--license.txt
Normal file
|
|
@ -0,0 +1,165 @@
|
|||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
|
||||
This version of the GNU Lesser General Public License incorporates
|
||||
the terms and conditions of version 3 of the GNU General Public
|
||||
License, supplemented by the additional permissions listed below.
|
||||
|
||||
0. Additional Definitions.
|
||||
|
||||
As used herein, "this License" refers to version 3 of the GNU Lesser
|
||||
General Public License, and the "GNU GPL" refers to version 3 of the GNU
|
||||
General Public License.
|
||||
|
||||
"The Library" refers to a covered work governed by this License,
|
||||
other than an Application or a Combined Work as defined below.
|
||||
|
||||
An "Application" is any work that makes use of an interface provided
|
||||
by the Library, but which is not otherwise based on the Library.
|
||||
Defining a subclass of a class defined by the Library is deemed a mode
|
||||
of using an interface provided by the Library.
|
||||
|
||||
A "Combined Work" is a work produced by combining or linking an
|
||||
Application with the Library. The particular version of the Library
|
||||
with which the Combined Work was made is also called the "Linked
|
||||
Version".
|
||||
|
||||
The "Minimal Corresponding Source" for a Combined Work means the
|
||||
Corresponding Source for the Combined Work, excluding any source code
|
||||
for portions of the Combined Work that, considered in isolation, are
|
||||
based on the Application, and not on the Linked Version.
|
||||
|
||||
The "Corresponding Application Code" for a Combined Work means the
|
||||
object code and/or source code for the Application, including any data
|
||||
and utility programs needed for reproducing the Combined Work from the
|
||||
Application, but excluding the System Libraries of the Combined Work.
|
||||
|
||||
1. Exception to Section 3 of the GNU GPL.
|
||||
|
||||
You may convey a covered work under sections 3 and 4 of this License
|
||||
without being bound by section 3 of the GNU GPL.
|
||||
|
||||
2. Conveying Modified Versions.
|
||||
|
||||
If you modify a copy of the Library, and, in your modifications, a
|
||||
facility refers to a function or data to be supplied by an Application
|
||||
that uses the facility (other than as an argument passed when the
|
||||
facility is invoked), then you may convey a copy of the modified
|
||||
version:
|
||||
|
||||
a) under this License, provided that you make a good faith effort to
|
||||
ensure that, in the event an Application does not supply the
|
||||
function or data, the facility still operates, and performs
|
||||
whatever part of its purpose remains meaningful, or
|
||||
|
||||
b) under the GNU GPL, with none of the additional permissions of
|
||||
this License applicable to that copy.
|
||||
|
||||
3. Object Code Incorporating Material from Library Header Files.
|
||||
|
||||
The object code form of an Application may incorporate material from
|
||||
a header file that is part of the Library. You may convey such object
|
||||
code under terms of your choice, provided that, if the incorporated
|
||||
material is not limited to numerical parameters, data structure
|
||||
layouts and accessors, or small macros, inline functions and templates
|
||||
(ten or fewer lines in length), you do both of the following:
|
||||
|
||||
a) Give prominent notice with each copy of the object code that the
|
||||
Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the object code with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
4. Combined Works.
|
||||
|
||||
You may convey a Combined Work under terms of your choice that,
|
||||
taken together, effectively do not restrict modification of the
|
||||
portions of the Library contained in the Combined Work and reverse
|
||||
engineering for debugging such modifications, if you also do each of
|
||||
the following:
|
||||
|
||||
a) Give prominent notice with each copy of the Combined Work that
|
||||
the Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the Combined Work with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
c) For a Combined Work that displays copyright notices during
|
||||
execution, include the copyright notice for the Library among
|
||||
these notices, as well as a reference directing the user to the
|
||||
copies of the GNU GPL and this license document.
|
||||
|
||||
d) Do one of the following:
|
||||
|
||||
0) Convey the Minimal Corresponding Source under the terms of this
|
||||
License, and the Corresponding Application Code in a form
|
||||
suitable for, and under terms that permit, the user to
|
||||
recombine or relink the Application with a modified version of
|
||||
the Linked Version to produce a modified Combined Work, in the
|
||||
manner specified by section 6 of the GNU GPL for conveying
|
||||
Corresponding Source.
|
||||
|
||||
1) Use a suitable shared library mechanism for linking with the
|
||||
Library. A suitable mechanism is one that (a) uses at run time
|
||||
a copy of the Library already present on the user's computer
|
||||
system, and (b) will operate properly with a modified version
|
||||
of the Library that is interface-compatible with the Linked
|
||||
Version.
|
||||
|
||||
e) Provide Installation Information, but only if you would otherwise
|
||||
be required to provide such information under section 6 of the
|
||||
GNU GPL, and only to the extent that such information is
|
||||
necessary to install and execute a modified version of the
|
||||
Combined Work produced by recombining or relinking the
|
||||
Application with a modified version of the Linked Version. (If
|
||||
you use option 4d0, the Installation Information must accompany
|
||||
the Minimal Corresponding Source and Corresponding Application
|
||||
Code. If you use option 4d1, you must provide the Installation
|
||||
Information in the manner specified by section 6 of the GNU GPL
|
||||
for conveying Corresponding Source.)
|
||||
|
||||
5. Combined Libraries.
|
||||
|
||||
You may place library facilities that are a work based on the
|
||||
Library side by side in a single library together with other library
|
||||
facilities that are not Applications and are not covered by this
|
||||
License, and convey such a combined library under terms of your
|
||||
choice, if you do both of the following:
|
||||
|
||||
a) Accompany the combined library with a copy of the same work based
|
||||
on the Library, uncombined with any other library facilities,
|
||||
conveyed under the terms of this License.
|
||||
|
||||
b) Give prominent notice with the combined library that part of it
|
||||
is a work based on the Library, and explaining where to find the
|
||||
accompanying uncombined form of the same work.
|
||||
|
||||
6. Revised Versions of the GNU Lesser General Public License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions
|
||||
of the GNU Lesser General Public License from time to time. Such new
|
||||
versions will be similar in spirit to the present version, but may
|
||||
differ in detail to address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Library as you received it specifies that a certain numbered version
|
||||
of the GNU Lesser General Public License "or any later version"
|
||||
applies to it, you have the option of following the terms and
|
||||
conditions either of that published version or of any later version
|
||||
published by the Free Software Foundation. If the Library as you
|
||||
received it does not specify a version number of the GNU Lesser
|
||||
General Public License, you may choose any version of the GNU Lesser
|
||||
General Public License ever published by the Free Software Foundation.
|
||||
|
||||
If the Library as you received it specifies that a proxy can decide
|
||||
whether future versions of the GNU Lesser General Public License shall
|
||||
apply, that proxy's public statement of acceptance of any version is
|
||||
permanent authorization for you to choose that version for the
|
||||
Library.
|
||||
7
main.rkt
Normal file
7
main.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#lang typed/racket
|
||||
(require "type-expander.hl.rkt"
|
||||
"more-expanders.hl.rkt"
|
||||
(for-syntax "expander.rkt"))
|
||||
(provide (all-from-out "type-expander.hl.rkt")
|
||||
(all-from-out "more-expanders.hl.rkt")
|
||||
(for-syntax colon))
|
||||
262
more-expanders.hl.rkt
Normal file
262
more-expanders.hl.rkt
Normal file
|
|
@ -0,0 +1,262 @@
|
|||
#lang hyper-literate typed/racket/base #:no-require-lang #:no-auto-require
|
||||
@; The #:no-require-lang above is needed because type-expander requires
|
||||
@; from 'main some identifiers (e.g. λ) which conflict with the re-required
|
||||
@; racket/base. With this option, we loose arrows in DrRacket for the
|
||||
@; built-ins in this file, and have otherwise no adverse effects.
|
||||
@(require scribble-enhanced/doc)
|
||||
@doc-lib-setup
|
||||
|
||||
@(module orig-ids racket/base
|
||||
(require scribble/manual
|
||||
(for-label typed/racket/base))
|
||||
(provide (all-defined-out))
|
||||
(define orig:: (racket :))
|
||||
(define orig:let (racket let))
|
||||
(define orig:→AnyBoolean:Integer (racket (→ Any Boolean : Integer))))
|
||||
@(require 'orig-ids)
|
||||
|
||||
@(unless-preexpanding
|
||||
(require racket/require
|
||||
(for-label "type-expander.hl.rkt"
|
||||
(submod "type-expander.hl.rkt" expander)
|
||||
(subtract-in typed/racket/base
|
||||
"type-expander.hl.rkt")
|
||||
(subtract-in racket
|
||||
typed/racket/base
|
||||
"type-expander.hl.rkt")
|
||||
typed/racket/unsafe
|
||||
racket/format
|
||||
racket/syntax
|
||||
syntax/stx
|
||||
syntax/parse
|
||||
syntax/parse/experimental/template
|
||||
syntax/id-table)))
|
||||
|
||||
@title[#:style manual-doc-style
|
||||
#:tag "ty-xp-more"
|
||||
#:tag-prefix "type-expander/ty-xp-more"]{Some example type expanders}
|
||||
|
||||
@(chunks-toc-prefix
|
||||
'("(lib type-expander/scribblings/type-expander-implementation.scrbl)"
|
||||
"type-expander/ty-xp-more"))
|
||||
|
||||
@section{Example type expanders: quasiquote and quasisyntax}
|
||||
|
||||
We define type expanders for @racket[quote], @racket[quasiquote],
|
||||
@racket[syntax] and @racket[quasisyntax]:
|
||||
|
||||
The next four special forms are implemented as type expanders with
|
||||
@tc[patch-type-expander] because redefining their name (@tc[quote],
|
||||
@tc[quasiquote], @tc[syntax] and @tc[quasisyntax]) would conflict with
|
||||
existing identifiers. @racket[patch-type-expander] uses a global persistant
|
||||
(across modules) for-syntax mutable table, which associates identifiers to
|
||||
type-expanders. @note{ @racketmodname[typed/racket] works in that way by
|
||||
associating data (their type) to existing identifiers. The
|
||||
@racketmodname[mutable-match-lambda] library on the other hand allows adding
|
||||
behaviour to an identifier after it is defined, but relies on some level of
|
||||
cooperation from that identifier, which may be less practical for built-in
|
||||
identifiers like @racket[quote].} Relying on an external data structure to
|
||||
associate information with identifiers makes it possible to overload the
|
||||
meaning of @tc[quote] or @tc[curry] when used as a type expander, without
|
||||
having to alter their original definition. Another option would be to provide
|
||||
overloaded versions of these identifiers, to shadow those imported by the
|
||||
@litchar{#lang} module. This would however cause conflicts for @tc[curry] when
|
||||
@tc[racket/function] is explicitly required (instead of being required
|
||||
implicitly by @racket[#,hash-lang #,(racketmodname racket)], for example.
|
||||
|
||||
@chunk[<quotes>
|
||||
(patch-type-expander quote
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ T)
|
||||
(expand-quasiquote 'quote 1 #'T)])))]
|
||||
|
||||
@chunk[<quotes>
|
||||
(patch-type-expander quasiquote
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ T)
|
||||
(expand-quasiquote 'quasiquote 1 #'T)])))]
|
||||
|
||||
@chunk[<quotes>
|
||||
(patch-type-expander syntax
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ T)
|
||||
(expand-quasiquote 'syntax 1 #'T)])))]
|
||||
|
||||
@chunk[<quotes>
|
||||
(patch-type-expander quasisyntax
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ T)
|
||||
(expand-quasiquote 'quasisyntax 1 #'T)])))]
|
||||
|
||||
Their implementation is factored out into the @tc[expand-quasiquote]
|
||||
for-syntax function. It is a reasonably complex showcase of this library's
|
||||
functionality. @racketmodname[typed/racket] allows the use of @tc[quote] to
|
||||
describe a type which contains a single inhabitant, the quoted datum. For
|
||||
example, @tc[(define-type foo '(a b (1 2 3) c))] declares a type @tc[foo]
|
||||
which is equivalent to @tc[(List 'a 'b (List 1 2 3) 'c)].
|
||||
|
||||
We build upon that idea to allow the use of @tc[syntax],
|
||||
@tc[quasiquote] and @tc[quasisyntax]. Both @tc[syntax] and
|
||||
@tc[quasisyntax] wrap each s-expression within the quoted
|
||||
datum with @tc[Syntaxof], which avoids the otherwise tedious
|
||||
declaration of the type for a piece of syntax. Both
|
||||
@tc[quasiquote] and @tc[quasisyntax] allow escaping the
|
||||
quoted datum (using @tc[unquote] and @tc[unsyntax],
|
||||
respectively). A later version of this library could
|
||||
support @tc[unquote-splicing] and @tc[unsyntax-splicing].
|
||||
|
||||
Using this type-expander, one can write
|
||||
@racketblock[(define-type bar `(a ,Symbol (1 ,(U Number String) 3) c))]
|
||||
The above declaration gets expanded to:
|
||||
@racketblock[(define-type bar (List 'a Symbol (List 1 (U Number String) 3) 'c))]
|
||||
|
||||
The implementation of @tc[expand-quasiquote] recursively
|
||||
traverses the type expression. The @tc[mode] argument
|
||||
can be one of @tc['quote], @tc['quasiquote], @tc['syntax] or
|
||||
@tc['quasisyntax]. It is used to determine whether to wrap
|
||||
parts of the type with @tc[Syntaxof] or not, and to know
|
||||
which identifier escapes the quoting (@tc[unquote] or
|
||||
@tc[unsyntax]). The @tc[depth] argument keeps track of the
|
||||
quoting depth: in Racket @tc[`(foo `(bar ,baz))] is
|
||||
equivalent to
|
||||
@tc[(list 'foo (list 'quasiquote (list 'bar (list 'unquote 'baz))))]
|
||||
(two levels of @tc[unquote] are required to escape the two
|
||||
levels of @tc[quasiquote]), so we want the type to be
|
||||
@tc[(List 'foo (List 'quasiquote (List 'bar (List 'unquote 'baz))))].
|
||||
|
||||
@CHUNK[<expand-quasiquote>
|
||||
(define (list*->list l)
|
||||
(if (pair? l)
|
||||
(cons (car l) (list*->list (cdr l)))
|
||||
(list l)))
|
||||
(define (expand-quasiquote mode depth stx)
|
||||
(define (wrap t)
|
||||
(if (or (eq? mode 'syntax) (eq? mode 'quasisyntax))
|
||||
#`(Syntaxof #,t)
|
||||
t))
|
||||
(define (wrap-quote t)
|
||||
(if (or (eq? mode 'syntax) (eq? mode 'quasisyntax))
|
||||
#`(Syntaxof (No-Expand (quote #,t)))
|
||||
#`(No-Expand (quote #,t))))
|
||||
(define expand-quasiquote-rec (curry expand-quasiquote mode depth))
|
||||
(syntax-parse stx
|
||||
[((~literal quote) T)
|
||||
(wrap #`(List #,(wrap-quote #'quote)
|
||||
#,(expand-quasiquote-rec #'T)))]
|
||||
[((~literal quasiquote) T)
|
||||
(wrap #`(List #,(wrap-quote #'quasiquote)
|
||||
#,(if (eq? mode 'quasiquote)
|
||||
(expand-quasiquote mode (+ depth 1) #'T)
|
||||
(expand-quasiquote-rec #'T))))]
|
||||
[((~literal unquote) T)
|
||||
(if (eq? mode 'quasiquote)
|
||||
(if (= depth 1)
|
||||
(expand-type #'T) ;; TODO: applicable? !!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
(wrap #`(List #,(wrap-quote #'unquote)
|
||||
#,(expand-quasiquote mode (- depth 1) #'T))))
|
||||
(wrap #`(List #,(wrap-quote #'unquote)
|
||||
#,(expand-quasiquote-rec #'T))))]
|
||||
[((~literal syntax) T)
|
||||
(wrap #`(List #,(wrap-quote #'quote)
|
||||
#,(expand-quasiquote-rec #'T)))]
|
||||
[((~literal quasisyntax) T)
|
||||
(wrap #`(List #,(wrap-quote #'quasisyntax)
|
||||
#,(if (eq? mode 'quasisyntax)
|
||||
(expand-quasiquote mode (+ depth 1) #'T)
|
||||
(expand-quasiquote-rec #'T))))]
|
||||
[((~literal unsyntax) T)
|
||||
(if (eq? mode 'quasisyntax)
|
||||
(if (= depth 1)
|
||||
(expand-type #'T) ;; TODO: applicable? !!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
(wrap #`(List #,(wrap-quote #'unsyntax)
|
||||
#,(expand-quasiquote mode (- depth 1) #'T))))
|
||||
(wrap #`(List #,(wrap-quote #'unsyntax)
|
||||
#,(expand-quasiquote-rec #'T))))]
|
||||
;; TODO For lists, we should consider the cases where syntax-e gives
|
||||
;; a pair vs the cases where it gives a list.
|
||||
[(T . U)
|
||||
#:when (syntax? (cdr (syntax-e stx)))
|
||||
(wrap #`(Pairof #,(expand-quasiquote-rec #'T)
|
||||
#,(expand-quasiquote-rec #'U)))]
|
||||
[() (wrap #'Null)]
|
||||
[(T ...)
|
||||
#:when (list? (syntax-e stx))
|
||||
(wrap #`(List #,@(stx-map expand-quasiquote-rec #'(T ...))))]
|
||||
[whole
|
||||
#:when (pair? (syntax-e #'whole))
|
||||
#:with (T ... S) (list*->list (syntax-e #'whole))
|
||||
(wrap #`(List* #,@(stx-map expand-quasiquote-rec #'(T ... S))))]
|
||||
[#(T ...)
|
||||
(wrap #`(Vector #,@(stx-map expand-quasiquote-rec #'(T ...))))]
|
||||
[#&T (wrap #`(Boxof #,(expand-quasiquote-rec #'T)))]
|
||||
; TODO: Prefab with #s(prefab-struct-key type ...)
|
||||
[T:id (wrap #'(No-Expand (quote T)))]
|
||||
[T #:when (string? (syntax-e #'T)) (wrap #'T)]
|
||||
[T:number (wrap #'T)]
|
||||
[T:keyword (wrap #'(No-Expand (quote T)))]
|
||||
[T:char (wrap #'T)]
|
||||
[#t (wrap #'True)]
|
||||
[#t (wrap #'False)]
|
||||
[_ (raise-syntax-error 'expand-quasiquoste
|
||||
(format "Unknown quasiquote contents: ~a" stx)
|
||||
stx)]))]
|
||||
|
||||
@section{Implementation of the @racket[Let*] special type expander form}
|
||||
|
||||
The @racket[Let*] special form is implemented in terms of @racket[Let],
|
||||
binding each variable in turn:
|
||||
|
||||
@chunk[<Let*>
|
||||
(define-type-expander (Let* stx)
|
||||
(syntax-case stx ()
|
||||
[(me ([var val] . rest) τ)
|
||||
(with-syntax ([L (datum->syntax #'here 'Let #'me #'me)]
|
||||
[L* (datum->syntax #'here 'Let* #'me #'me)])
|
||||
#'(L ([var val])
|
||||
(L* rest
|
||||
τ)))]
|
||||
[(_ () τ) #'τ]))]
|
||||
|
||||
@section{curry}
|
||||
|
||||
The @tc[curry] special form takes a type expander (or a polymorphic type) and
|
||||
some arguments. The whole form should appear in the first position of its
|
||||
containing form, which contains more arguments, or be bound with a
|
||||
@racket[Let] or @racket[Letrec]. @tc[curry] appends the arguments in the outer
|
||||
form to the whole inner form, and expands the result. This really should be
|
||||
implemented as a type expander so that the partially-applied expander or
|
||||
polymorphic type can be bound using @tc[Let], for example, but for now it is
|
||||
hardcoded here.
|
||||
|
||||
@chunk[<curry>
|
||||
(patch-type-expander curry
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ T Arg1 ...)
|
||||
#'(Λ (_ . Args2) #'(T Arg1 ... . Args2))])))]
|
||||
|
||||
@section{Putting it all together}
|
||||
|
||||
@chunk[<*>
|
||||
(require "type-expander.hl.rkt"
|
||||
"identifiers.rkt"
|
||||
racket/function
|
||||
(for-syntax racket/base
|
||||
(only-in racket/base [... …])
|
||||
(submod "type-expander.hl.rkt" expander)
|
||||
syntax/parse
|
||||
syntax/stx
|
||||
racket/function
|
||||
racket/match))
|
||||
(provide Let*)
|
||||
|
||||
<Let*>
|
||||
|
||||
(begin-for-syntax <expand-quasiquote>)
|
||||
<quotes>
|
||||
|
||||
<curry>]
|
||||
146
parameterize-lexical-context.rkt
Normal file
146
parameterize-lexical-context.rkt
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
#lang racket
|
||||
|
||||
(require (for-template racket/base)
|
||||
syntax/parse
|
||||
syntax/id-table
|
||||
(for-syntax syntax/parse
|
||||
racket/syntax
|
||||
syntax/parse/experimental/template)
|
||||
debug-scopes)
|
||||
|
||||
(provide with-bindings
|
||||
with-rec-bindings
|
||||
tl-redirections
|
||||
start-tl-redirections
|
||||
f-start-tl-redirections
|
||||
binding-table-find-best
|
||||
binding-table-set!
|
||||
make-binding-table)
|
||||
|
||||
(struct binding-table-struct (val))
|
||||
|
||||
(define/contract tl-redirections
|
||||
(parameter/c (or/c binding-table-struct? #f))
|
||||
(make-parameter #f))
|
||||
|
||||
(define (make-binding-table)
|
||||
(-> binding-table-struct?)
|
||||
(binding-table-struct (make-hasheq)))
|
||||
|
||||
(define/contract (binding-table-set! table id value)
|
||||
(-> binding-table-struct? identifier? any/c void?)
|
||||
(let ([group (hash-ref! (binding-table-struct-val table)
|
||||
(syntax-e id)
|
||||
(make-bound-id-table))])
|
||||
(when (dict-has-key? group id)
|
||||
(raise-syntax-error
|
||||
'type-expander
|
||||
"Attempted to re-bind the same identifier with the same scopes"
|
||||
id))
|
||||
(bound-id-table-set! group id value)))
|
||||
|
||||
(define (binding-table-find-best table id fallback)
|
||||
(-> binding-table-struct? identifier? (or/c procedure? any/c) void?)
|
||||
(define (scopes-of i)
|
||||
(list->set (map (λ (v) (vector-ref v 0))
|
||||
(hash-ref (syntax-debug-info i) 'context))))
|
||||
(define scopes-of-id (scopes-of id))
|
||||
(let* ([group (hash-ref (binding-table-struct-val table)
|
||||
(syntax-e id)
|
||||
(λ () (make-bound-id-table)))]
|
||||
[candidates (filter (λ (other)
|
||||
(subset? (car other) scopes-of-id))
|
||||
(bound-id-table-map group
|
||||
(λ (a b)
|
||||
(list (scopes-of a) a b))))])
|
||||
(if (= 0 (length candidates))
|
||||
(if (procedure? fallback)
|
||||
(fallback)
|
||||
fallback)
|
||||
(let* ([best-candidate (argmax (λ (c) (set-count (car c)))
|
||||
candidates)])
|
||||
(for ([c candidates])
|
||||
(unless (subset? (car c) (car best-candidate))
|
||||
(raise-syntax-error 'type-expander
|
||||
(format "Ambiguous bindings: ~a"
|
||||
(map (λ (c) (list (cadr c) (car c)))
|
||||
candidates)))))
|
||||
(caddr best-candidate)))))
|
||||
|
||||
(define-syntax-rule (start-tl-redirections . rest)
|
||||
(parameterize ([tl-redirections (or (tl-redirections)
|
||||
(make-binding-table))])
|
||||
. rest))
|
||||
|
||||
(define-syntax-rule (f-start-tl-redirections f)
|
||||
(λ l (start-tl-redirections (apply f l))))
|
||||
|
||||
|
||||
(define-syntax with-bindings
|
||||
(syntax-parser
|
||||
[(_ [{~or v1:id (v* {~and ooo {~literal ...}})} e/es] x code ...+)
|
||||
#:with vs (if (attribute ooo) #'(v* ooo) #'(v1))
|
||||
#:with es (if (attribute ooo) #'e/es #'(list e/es))
|
||||
(template
|
||||
(let ()
|
||||
(define ctx (make-syntax-introducer))
|
||||
(invariant-assertion (λ (ll) (and (list? ll)
|
||||
(andmap identifier? ll)))
|
||||
(syntax->list #'vs))
|
||||
(for ([binding (in-syntax #'vs)]
|
||||
[value es])
|
||||
(binding-table-set! (tl-redirections) (ctx binding) value))
|
||||
(with-syntax ([(vs x)
|
||||
(ctx #'(vs x))])
|
||||
code ...)))]))
|
||||
|
||||
(define-syntax with-rec-bindings
|
||||
(syntax-parser
|
||||
[(_ [{~or v1:id (v* {~and ooo {~literal ...}})} func e/es] x code ...+)
|
||||
#:with vs (if (attribute ooo) #'(v* ooo) #'(v1))
|
||||
#:with es (if (attribute ooo) #'(e/es ooo) #'(e/es))
|
||||
(template
|
||||
(let ()
|
||||
(define ctx (make-syntax-introducer))
|
||||
(define ctx2 (make-syntax-introducer #t))
|
||||
(invariant-assertion (λ (ll) (and (list? ll)
|
||||
(andmap identifier? ll)))
|
||||
(syntax->list #'vs))
|
||||
(for ([binding (in-syntax #'vs)]
|
||||
[stx-value (in-syntax #'es)])
|
||||
(let ([vvv (func (ctx stx-value))])
|
||||
(binding-table-set! (tl-redirections)
|
||||
(ctx binding)
|
||||
vvv)))
|
||||
(with-syntax ([(vs x)
|
||||
(ctx2 (ctx #'(vs x)))])
|
||||
code ...)))]))
|
||||
|
||||
(provide trampoline-eval)
|
||||
(define trampoline-result (make-parameter #f))
|
||||
(define (trampoline-eval code)
|
||||
(define result 'not-yet-result)
|
||||
(parameterize ([trampoline-result (λ (v) (set! result v))])
|
||||
(local-expand (syntax-local-introduce
|
||||
#`(let-syntax ([tr ((trampoline-result) #,code)])
|
||||
(void)))
|
||||
'expression
|
||||
'()))
|
||||
result)
|
||||
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-equal? (let ()
|
||||
(define tbl (make-binding-table))
|
||||
(define id #'id)
|
||||
(binding-table-set! tbl id 123)
|
||||
(define ctx (make-syntax-introducer))
|
||||
(binding-table-set! tbl (ctx id) 456)
|
||||
(define ctx2 (make-syntax-introducer))
|
||||
(list (binding-table-find-best tbl id #f)
|
||||
(binding-table-find-best tbl (ctx id) #f)
|
||||
(binding-table-find-best tbl (ctx2 id) #f)
|
||||
(binding-table-find-best tbl (ctx2 (ctx id)) #f)
|
||||
(binding-table-find-best tbl (ctx (ctx2 id)) #f)))
|
||||
'(123 456 123 456 456)))
|
||||
23
scribblings/deprecated-colon.scrbl
Normal file
23
scribblings/deprecated-colon.scrbl
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
#lang scribble/manual
|
||||
|
||||
@require[@for-label[type-expander]]
|
||||
|
||||
@(module m racket/base
|
||||
(require scribble/manual)
|
||||
(provide e:colon)
|
||||
(require (for-label type-expander/expander))
|
||||
(define e:colon (racket colon)))
|
||||
@(require 'm)
|
||||
|
||||
@title{Deprecated export of @racket[colon] via @racketmodname[type-expander]}
|
||||
|
||||
@declare-exporting[type-expander]
|
||||
|
||||
@defidform[colon]{
|
||||
@deprecated[
|
||||
#:what "reprovide"
|
||||
@list{@e:colon from @racketmodname[type-expander/expander]}
|
||||
@list{The @e:colon identifier is re-exported for-syntax as @racket[colon] by
|
||||
@racketmodname[type-expander]. Prefer instead explicitly using
|
||||
@racket[(require (for-syntax #,(racketmodname type-expander/expander)))], as
|
||||
the re-export will be removed in future versions.}]}
|
||||
12
scribblings/type-expander-implementation.scrbl
Normal file
12
scribblings/type-expander-implementation.scrbl
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
#lang scribble/manual
|
||||
|
||||
@title{Type expander: Implementation}
|
||||
@author[@author+email["Georges Dupéron" "georges.duperon@gmail.com"]]
|
||||
|
||||
This library is implemented using literate programming. The implementation
|
||||
details are presented in the following sections. The user documentation is in
|
||||
the @other-doc['(lib "type-expander/scribblings/type-expander.scrbl")] document.
|
||||
|
||||
@(table-of-contents)
|
||||
@include-section[(submod "../type-expander.hl.rkt" doc)]
|
||||
@include-section[(submod "../more-expanders.hl.rkt" doc)]
|
||||
844
scribblings/type-expander.scrbl
Normal file
844
scribblings/type-expander.scrbl
Normal file
|
|
@ -0,0 +1,844 @@
|
|||
#lang scribble/manual
|
||||
|
||||
@title{Type expander library}
|
||||
@author{@author+email["Georges Dupéron" "georges.duperon@gmail.com"]}
|
||||
|
||||
@defmodule[type-expander
|
||||
#:use-sources [(lib "type-expander/type-expander.hl.rkt")
|
||||
(lib "type-expander/more-expanders.hl.rkt")]]
|
||||
|
||||
@require[racket/require
|
||||
scribble/example
|
||||
@for-syntax[racket/base]
|
||||
@for-label[type-expander
|
||||
type-expander/expander
|
||||
(subtract-in typed/racket/base
|
||||
type-expander
|
||||
type-expander/expander)
|
||||
(only-in racket/base [... …])
|
||||
(prefix-in racket/base: racket/base)
|
||||
syntax/stx
|
||||
racket/list
|
||||
syntax/parse
|
||||
syntax/parse/experimental/template
|
||||
auto-syntax-e
|
||||
debug-scopes]]
|
||||
|
||||
@(require (for-syntax syntax/strip-context
|
||||
syntax/stx
|
||||
racket/syntax))
|
||||
@(define-syntax (orig stx)
|
||||
(syntax-case stx ()
|
||||
[(_ name ...)
|
||||
(with-syntax ([(prefixed ...)
|
||||
(stx-map (λ (id) (format-id id "orig:~a" id))
|
||||
#'(name ...))])
|
||||
#`(begin
|
||||
(module #,(syntax-local-introduce #'orig-module) .
|
||||
#,(strip-context
|
||||
#'(racket/base
|
||||
(require (for-label (only-meta-in 0 (only-in typed/racket
|
||||
name ...))))
|
||||
(require scribble/manual)
|
||||
(define prefixed @racket[name]) ...
|
||||
(provide prefixed ...))))
|
||||
(require #,(syntax-local-introduce #''orig-module))))]))
|
||||
|
||||
@(orig
|
||||
class
|
||||
;;
|
||||
define-type
|
||||
;; TODO: add all-defined-out in prims.rkt
|
||||
;; top-interaction.rkt
|
||||
:type
|
||||
:print-type
|
||||
:query-type/args
|
||||
:query-type/result
|
||||
;; case-lambda.rkt
|
||||
case-lambda
|
||||
case-lambda:
|
||||
pcase-lambda:
|
||||
;; (submod "prims-contract.rkt" forms)
|
||||
require/opaque-type
|
||||
;require-typed-struct-legacy
|
||||
require-typed-struct
|
||||
;require/typed-legacy
|
||||
require/typed
|
||||
require/typed/provide
|
||||
require-typed-struct/provide
|
||||
cast
|
||||
make-predicate
|
||||
define-predicate
|
||||
;; prims.rkt
|
||||
define-type-alias
|
||||
define-new-subtype
|
||||
define-typed-struct
|
||||
define-typed-struct/exec
|
||||
ann
|
||||
inst
|
||||
:
|
||||
define-struct:
|
||||
define-struct
|
||||
struct
|
||||
struct:
|
||||
λ:
|
||||
lambda:
|
||||
lambda
|
||||
λ
|
||||
define
|
||||
let
|
||||
let*
|
||||
letrec
|
||||
let-values
|
||||
letrec-values
|
||||
let/cc
|
||||
let/ec
|
||||
let:
|
||||
let*:
|
||||
letrec:
|
||||
let-values:
|
||||
letrec-values:
|
||||
let/cc:
|
||||
let/ec:
|
||||
for
|
||||
for/list
|
||||
for/vector
|
||||
for/hash
|
||||
for/hasheq
|
||||
for/hasheqv
|
||||
for/and
|
||||
for/or
|
||||
for/sum
|
||||
for/product
|
||||
for/lists
|
||||
for/first
|
||||
for/last
|
||||
for/fold
|
||||
for*
|
||||
for*/list
|
||||
for*/lists
|
||||
for*/vector
|
||||
for*/hash
|
||||
for*/hasheq
|
||||
for*/hasheqv
|
||||
for*/and
|
||||
for*/or
|
||||
for*/sum
|
||||
for*/product
|
||||
for*/first
|
||||
for*/last
|
||||
for*/fold
|
||||
for/set
|
||||
for*/set
|
||||
do
|
||||
do:
|
||||
with-handlers
|
||||
define-struct/exec:
|
||||
define-struct/exec)
|
||||
|
||||
@(define eval-factory
|
||||
(make-eval-factory (list 'typed/racket 'type-expander)))
|
||||
|
||||
This library is implemented using literate programming. The
|
||||
implementation details are presented in the
|
||||
@other-doc['(lib
|
||||
"type-expander/scribblings/type-expander-implementation.scrbl")]
|
||||
document.
|
||||
|
||||
It enhances @racketmodname[typed/racket] with
|
||||
@deftech[#:key "type expander"]{type expanders}, which are
|
||||
special macros that can appear wherever a regular type is
|
||||
usually expected, and must expand to a type. Type expanders
|
||||
are to types what
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")
|
||||
#:key "match expander"]{
|
||||
match expanders} are to @racket[match] patterns.
|
||||
|
||||
It is based on
|
||||
@hyperlink[(string-append "https://github.com/racket/racket/compare/"
|
||||
"master...takikawa:tr-type-expander")]{
|
||||
Asumu Takikawa's type expanders} (see also his
|
||||
@hyperlink["https://github.com/racket/racket/pull/604"]{original pull request}).
|
||||
Asumu Takikawa's work attempted to integrate type expanders
|
||||
directly into Typed/Racket. This project instead implements
|
||||
type expanders as a library, which does not need any changes
|
||||
to the core Typed/Racket codebase. This shows the
|
||||
extensibility of Typed/Racket thanks to macros, and could
|
||||
serve as the basis for other projects which need to alter
|
||||
how Typed/Racket handles types.
|
||||
|
||||
The input for a type expander is the syntax used to call
|
||||
it, just as the input to a macro is the syntax used to call
|
||||
it. The output should be a type, which can itself contain
|
||||
type expanders.
|
||||
|
||||
This library works by shadowing the definitions of
|
||||
@orig::, @orig:define, @orig:lambda @etc from
|
||||
@racketmodname[typed/racket] with versions which support
|
||||
type expanders.
|
||||
|
||||
@section{@(hash-lang) and module languages based on
|
||||
@racketmodname[type-expander]}
|
||||
|
||||
@subsection{@(hash-lang) combining @racketmodname[type-expander] and
|
||||
@racketmodname[typed/racket]}
|
||||
|
||||
@defmodulelang[type-expander
|
||||
#:link-target? #f]{
|
||||
The @racket[#,(hash-lang) #,(racketmodname type-expander)] language works like
|
||||
@racket[#,(hash-lang) #,(racketmodname typed/racket)], but it initially imports
|
||||
the forms overridden by @racketmodname[type-expander], instead of importing
|
||||
the original identifiers defined by @racket[typed/racket].
|
||||
|
||||
This language cannot be used as a module language, instead use
|
||||
@racketmodname[type-expander/lang] which provides the same bindings.}
|
||||
|
||||
@subsection{Module language combining @racketmodname[type-expander] and
|
||||
@racketmodname[typed/racket]}
|
||||
|
||||
@defmodulelang[type-expander/lang]{
|
||||
This language is equivalent to
|
||||
@racket[#,(hash-lang) #,(racketmodname type-expander)], but can also be used as
|
||||
a module language.}
|
||||
|
||||
@subsection{@(hash-lang) and module language combining
|
||||
@racketmodname[type-expander] and @racketmodname[typed/racket/base]}
|
||||
|
||||
@defmodulelang[type-expander/base]{
|
||||
This language is similar to @racketmodname[type-expander/lang], but it
|
||||
exports the identifiers from @racketmodname[typed/racket/base] instead of
|
||||
@racket[typed/racket].}
|
||||
|
||||
|
||||
@section{Defining new type expanders}
|
||||
|
||||
@defform*[((define-type-expander (name stx) . body)
|
||||
(define-type-expander name transformer-function))
|
||||
#:grammar ([name Identifier]
|
||||
[stx Identifier]
|
||||
[transformer-function (expr/c (-> syntax? syntax?))])]{
|
||||
The @racket[define-type-expander] form binds
|
||||
@racket[_name] to a type expander, which can be used in
|
||||
places where a type would normally be expected.
|
||||
|
||||
For example, one could define the @racket[HomogeneousList]
|
||||
type expander, which accepts a type @racket[_t] and an
|
||||
integer @racket[_n], and produces a @racket[List] type with
|
||||
@racket[_n] elements, each of type @racket[_t]:
|
||||
|
||||
@racketblock[
|
||||
(define-type-expander (HomogeneousList stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n)
|
||||
(number? (syntax-e #'n))
|
||||
(with-syntax ([(tᵢ ...) (stx-map (const #'t)
|
||||
(range (syntax-e #'n)))])
|
||||
#'(List tᵢ ...))]))]}
|
||||
|
||||
@subsection{Attaching type expanders to existing identifiers}
|
||||
|
||||
@defform[(patch-type-expander name transformer-function)
|
||||
#:grammar ([name Identifier]
|
||||
[transformer-function (expr/c (-> syntax? syntax?))])]{
|
||||
This macro records in a global table that @racket[name] should behave
|
||||
according to the given @racket[transformer-function], when used as a type.
|
||||
|
||||
It allows attaching type expanders to existing identifiers, without shadowing
|
||||
them. It is used for example to attach the type expanders for @racket[quote],
|
||||
@racket[quasiquote], @racket[syntax] and @racket[quasisyntax] which are
|
||||
described below, and also for the @racket[curry] type expander.}
|
||||
|
||||
@section{Using a type expander}
|
||||
|
||||
The @racket[HomogeneousList] type expander defined above could be
|
||||
used in many of @racketmodname[typed/racket]'s forms.
|
||||
|
||||
@racketblock[
|
||||
(define-type three-ints (HomogeneousList 3 Integer))
|
||||
(define (incr3 [x : three-ints]) : HomogeneousList
|
||||
(map add1 x))
|
||||
(ann (incr3 '(1 2 3)) HomogeneousList)]
|
||||
|
||||
Type expanders can produce types which may contain other
|
||||
uses of type expanders, much in the same way as macros can
|
||||
expand to code calling other macros. The type expander can
|
||||
also produce directly a call to another type expander, just
|
||||
as a macro can expand to a call to another macro, without
|
||||
any extra surrounding syntax.
|
||||
|
||||
@; TODO: examples
|
||||
|
||||
Contrarily to macros, if a call to a type expander is in the
|
||||
first position of more arguments, then the nested call is
|
||||
first expanded, and can produce the name of a second
|
||||
expander which will use the outer arguments, or can simply
|
||||
produce a polymorphic type which will be applied to the
|
||||
arguments. More than two levels of nesting are possible.
|
||||
|
||||
@; TODO: examples with two levels and more.
|
||||
|
||||
@section{Debugging type expanders}
|
||||
|
||||
@defform*[[(debug-type-expander #t)
|
||||
(debug-type-expander #f)]]{
|
||||
The first form enables printing of debugging information while expanding
|
||||
types, and the second form disables that behaviour. Debugging information is
|
||||
not printed by default.
|
||||
|
||||
Currently, when debugging information is enabled, the type expander prints at
|
||||
each step a human-readable representation of the syntax object it is about to
|
||||
expand, and once an expansion step finishes, it prints the original syntax
|
||||
object as well as its expanded form. The identifiers are adorned with
|
||||
superscripts indicating the scopes present on them. See the documentation for
|
||||
the debugging tool @racket[+scopes] for more details.}
|
||||
|
||||
@section{Compile-time aspects of type expanders}
|
||||
|
||||
@defmodule[type-expander/expander
|
||||
#:use-sources
|
||||
[(submod (lib "type-expander/type-expander.hl.rkt") expander)
|
||||
(submod (lib "type-expander/type-expander.hl.rkt") main)]]
|
||||
|
||||
@defproc[(expand-type [stx Type]) PlainType]{
|
||||
Fully expands the type @racket[stx], which may contain any
|
||||
number of calls to type expanders. If those calls result in
|
||||
more type expanders, those are expanded too.}
|
||||
|
||||
@defproc[(apply-type-expander [type-expander-stx Identifier] [stx Syntax])
|
||||
Type]{
|
||||
Produces the result of applying the type expander bound to
|
||||
@racket[type-expander-stx] to the syntax @racket[stx].
|
||||
Normally, the syntax @racket[stx] would be of the form
|
||||
@racket[(type-expander-stx arg …)] (similar to a macro
|
||||
call) or simply @racket[type-expander-stx] (similar to an
|
||||
@tech[#:doc '(lib
|
||||
"scribblings/guide/guide.scrbl")]{identifier
|
||||
macro}). It is however possible to pass arbitrary syntax
|
||||
to the type expander, just as it is possible for macros
|
||||
(for example @racket[set!] calls
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{
|
||||
assignment transformer} macros with the syntax
|
||||
@racket[(set! macro-name arg …)] as an argument).}
|
||||
|
||||
@defthing[prop:type-expander struct-type-property?]{
|
||||
A
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{
|
||||
structure type property} to identify structure types that
|
||||
act as @tech[#:key "type expander"]{type expanders} like
|
||||
the ones created by @racket[define-type-expander].
|
||||
|
||||
The property value must be a procedure of arity 1 or an
|
||||
@racket[exact-nonnegative-integer?] designating a field
|
||||
index within the structure which contains such a
|
||||
procedure.
|
||||
|
||||
The procedure serves as a syntax transformer when
|
||||
expanding the use of a type expander. If the type expander
|
||||
was in the first position of a syntax list (i.e. it looks
|
||||
like a macro or function call), then the whole syntax list
|
||||
is passed as an argument. Otherwise, just the identifier is
|
||||
passed as an argument, exactly as what would be done when
|
||||
calling an
|
||||
@tech[#:doc '(lib
|
||||
"scribblings/guide/guide.scrbl")]{identifier macro}. The
|
||||
procedure can support other use patterns if desired, so
|
||||
that it would be possible in principle to implement special
|
||||
type forms that behave in a way similar to
|
||||
@secref["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")].}
|
||||
|
||||
@subsection{Syntax class for @racketid[:]}
|
||||
|
||||
@defidform[#:kind "syntax-parse syntax class"
|
||||
colon]{
|
||||
This library shadows the @orig:: identifier from
|
||||
@racketmodname[typed/racket] with a new definition
|
||||
@racket[:], adjusted to handle type expanders. Programs
|
||||
using the @racketmodname[type-expander] library will
|
||||
therefore use our version of @racket[:]. The @racket[:]
|
||||
identifier provided by this library is not
|
||||
@racket[free-identifier=?] with the original @orig:: from
|
||||
@racketmodname[typed/racket]. This has an impact when
|
||||
writing patterns for the @racketmodname[syntax/parse]
|
||||
library, as the two identifiers @racket[:] and @orig:: are
|
||||
not the same from the point of view of the
|
||||
@racket[~literal] pattern.
|
||||
|
||||
The @racket[colon] syntax class is provided
|
||||
@racket[for-syntax] by this library, and can be used in
|
||||
@racket[syntax-parse] patterns, using @racket[c:colon] for
|
||||
example. It matches both the original @orig:: and the new
|
||||
@racket[:], but not other @racketid[:] identifiers.
|
||||
|
||||
It can be used to write macros which expect either
|
||||
@racketid[:] identifier.}
|
||||
|
||||
@subsection{Syntax classes for types}
|
||||
|
||||
@defidform[#:kind "syntax-parse syntax class"
|
||||
type]{
|
||||
Matches a type. For now, this is just an alias for @racket[expr], because types
|
||||
can contain arbitrary syntax thanks to type expanders.}
|
||||
|
||||
@defthing[stx-type/c flat-contract?]{
|
||||
Flat contract which recognises syntax objects representing types. For now,
|
||||
this is just an alias for @racket[syntax?], because types can contain
|
||||
arbitrary syntax thanks to type expanders.
|
||||
|
||||
Future versions may implement this as a non-flat contract, in order to be
|
||||
able to check that in a macro's result, the syntax for a type is not used as
|
||||
an expression, and vice versa.}
|
||||
|
||||
@defidform[#:kind "syntax-parse syntax class"
|
||||
type-expand!]{
|
||||
Matches a type @racket[_t], and provides an attribute named @racket[expanded]
|
||||
which contains the result of @racket[(expand-type #'_t)]. For now,
|
||||
@racket[type-expand] does not perform any check other than verifying that
|
||||
@racket[_t] is an @racket[expr], because types can contain arbitrary syntax
|
||||
thanks to type expanders.}
|
||||
|
||||
@section{multi-id}
|
||||
|
||||
@; TODO: separate multi-id or type-expander into two packages, so that we can
|
||||
@; write @racketmodname[multi-id] without causing a circular dependency:
|
||||
Type expanders are supported by the multi-id library. It is
|
||||
therefore easy to define an identifier which acts as a type
|
||||
expander and match expander as well as a regular racket
|
||||
macro and/or
|
||||
@tech[#:doc '(lib
|
||||
"scribblings/guide/guide.scrbl")]{identifier macro}. This
|
||||
can be useful to define feature-rich data structures, which
|
||||
need to provide all of the above features.
|
||||
|
||||
@section{Expansion model for type expanders}
|
||||
|
||||
The expansion model for type expanders is similar to the expansion model for
|
||||
macros. There are a few differences, however, which are presented below.
|
||||
|
||||
@itemlist[
|
||||
@item{When a form like @racket[(f args ... . rest)] is encountered, if its
|
||||
first element, @racket[f], is a type expander, the type expander is applied to
|
||||
the whole form. If @racket[f] is a special identifier (e.g. like @racket[Let]
|
||||
or @racket[Rec]), then the form is handled according to the special
|
||||
identifier's rules. Otherwise, the @racket[f] form is expanded, and the result
|
||||
@racket[(e args ... . rest)] is expanded once again (@racket[e] being the
|
||||
result of the expansion of @racket[f]).
|
||||
|
||||
In comparison, the ``official'' macro expander for Racket would, in the last
|
||||
case, expand @racket[f] on its own, and then expand the arguments one by one
|
||||
without re-considering the form as a whole.
|
||||
|
||||
|
||||
With the type expander, during the second expansion pass for the form, if the
|
||||
@racket[e] identifier is a type expander it is applied to the whole form. If
|
||||
@racket[e] is a special identifier, the form is processed following that
|
||||
identifier's rules. Otherwise, the @racket[e] form is left intact, and the
|
||||
arguments @racket[args ...] and @racket[rest] are expanded each in turn.
|
||||
|
||||
In comparison, the ``official'' macro expander would have fully expanded
|
||||
@racket[e] in isolation (e.g. as an identifier macro), without letting it take
|
||||
over the arguments.}
|
||||
@item{With the ``official'' macro expander, all forms at the same lexical
|
||||
scoping level are expanded before expanding the contents of @racket[let]
|
||||
forms.
|
||||
|
||||
In contrast, the type expander expands the contents of @racket[Let] forms in
|
||||
the same order as other forms. It further replaces the @racket[Let] forms by
|
||||
their contents, so that the following type:
|
||||
|
||||
@racketblock[((Let ([Foo Pairof]) Foo) Number String)]
|
||||
|
||||
gets expanded by replacing @racket[(Let ([Foo Pairof]) Foo)] by its contents
|
||||
(i.e. the @racket[Foo] identifier in this case):
|
||||
|
||||
@racketblock[(Foo Number String)]
|
||||
|
||||
The @racket[Foo] identifier is still bound to @racket[Pairof], so this new
|
||||
type expression gets expanded to:
|
||||
|
||||
@racketblock[(Pairof Number String)]
|
||||
|
||||
This means that identifiers bound by @racket[Let] forms can escape their
|
||||
scope, but are still attached to their defining scope.}
|
||||
@item{With the current implementation of the type expander,
|
||||
@racket[syntax-local-value] ignores types bound by @racket[Let] forms. A
|
||||
future version of this library will (hopefully) either fix this problem, or
|
||||
provide an alternative @racket[syntax-local-type-value] which takes those
|
||||
bindings into account.}]
|
||||
|
||||
@section{Built-in type expanders}
|
||||
|
||||
There are several built-in expanders. Some are documented
|
||||
here, while others are listed in
|
||||
@secref["Cases_handled_by_expand-type"
|
||||
#:doc '(lib "type-expander/type-expander.hl.rkt")].
|
||||
Their API should be considered unstable, and may change in
|
||||
the future.
|
||||
|
||||
@subsection{Let}
|
||||
|
||||
@defform[#:kind "type expander"
|
||||
(Let ([Vᵢ Eᵢ] …) τ)
|
||||
#:grammar
|
||||
([Vᵢ Identifier]
|
||||
[Eᵢ Type]
|
||||
[τ Type])]{
|
||||
The @racket[Let] form binds each type expression
|
||||
@racket[Eᵢ] (which may contain uses of type expanders bound
|
||||
outside of the @racket[Let] form) to the identifier @racket[Vᵢ].
|
||||
The type @racket[τ] can contain type expanders and can
|
||||
refer to occurrences of the bound @racket[Vᵢ] identifiers,
|
||||
which will expand to @racket[Eᵢ]. The @racket[Let] form therefore
|
||||
behaves is a way similar to @racket[let-syntax].
|
||||
|
||||
@examples[#:eval (eval-factory)
|
||||
(ann '(1 2 3)
|
||||
(Let ([Foo Number])
|
||||
(Listof Foo)))
|
||||
(eval:error (ann '(1 2 3)
|
||||
(Listof Foo)))]
|
||||
|
||||
@examples[#:eval (eval-factory)
|
||||
(ann '([1 . "a"] [2 . b] [3 . 2.71])
|
||||
(Let ([Foo (Λ (_ T)
|
||||
#'(Pairof Number T))])
|
||||
(List (Foo String)
|
||||
(Foo Symbol)
|
||||
(Foo Float))))]
|
||||
|
||||
@examples[#:eval (eval-factory)
|
||||
(ann '(a b c)
|
||||
(Let ([Foo Number])
|
||||
(Let ([Foo String])
|
||||
(Let ([Foo Symbol])
|
||||
(Listof Foo)))))
|
||||
(ann '(a b c)
|
||||
(Let ([Foo Number])
|
||||
(Listof (Let ([Foo String])
|
||||
(Let ([Foo Symbol])
|
||||
Foo)))))]}
|
||||
|
||||
@subsection{Letrec}
|
||||
|
||||
@defform[#:kind "type expander"
|
||||
(Letrec ([Vᵢ Eᵢ] …) τ)]{
|
||||
Like @racket[Let], but all the @racket[Vᵢ] identifiers are bound within all
|
||||
the @racket[Eᵢ] type expressions. This means the type expression within an
|
||||
@racket[Eᵢ] can refer to any @racket[Vᵢ] of the same @racket[Letrec].}
|
||||
|
||||
|
||||
@subsection{Let*}
|
||||
|
||||
@defform[#:kind "type expander"
|
||||
(Let* ([Vᵢ Eᵢ] …) τ)]{
|
||||
Like @racket[Let], but all the preceding @racket[Vᵢ] identifiers are bound
|
||||
each @racket[Eᵢ] type expression. This means the type expression within an
|
||||
@racket[Eᵢ] can refer to any @racket[Vᵢ] already bound above it, but not to
|
||||
the @racket[Vᵢ] it is being bound to, nor to the following @racket[Vᵢ].}
|
||||
|
||||
@subsection{Λ}
|
||||
|
||||
@defform[#:kind "type expander"
|
||||
(Λ formals . body)
|
||||
#:grammar
|
||||
([stx Identifier])]{
|
||||
|
||||
The @racket[Λ] form (a capital @racketid[λ]) can be used to construct an
|
||||
anonymous type expander. It is equivalent to replacing the whole
|
||||
@racket[(Λ formals . body)] form with @racket[_generated-id], where
|
||||
@racket[_generated-id] is defined as a named type expander as follows:
|
||||
|
||||
@racketblock[(define-type-expander (_gen-id _gen-stx-id)
|
||||
(auto-syntax-case _gen-stx-id ()
|
||||
[formals (let () . body)]))]
|
||||
|
||||
where @racket[_id] and @racket[_gen-stx-id] are fresh unique identifiers.
|
||||
|
||||
Since @racket[Λ] relies on @racket[auto-syntax-case], the syntax pattern
|
||||
variables bound by @racket[formals] can also be used outside of syntax
|
||||
templates, in which case they evaluate to @racket[(syntax->datum #'pvar)].
|
||||
|
||||
@examples[#:eval (eval-factory)
|
||||
#:escape UNSYNTAX
|
||||
(eval:no-prompt (require (for-syntax racket/list racket/function)))
|
||||
(ann '(1 2 3 4)
|
||||
((Λ (_ T n)
|
||||
#`(List #,@(map (const #'T) (range n))))
|
||||
Number 4))]}
|
||||
|
||||
@subsection{Quasiquote}
|
||||
|
||||
The type expander library also adds support for
|
||||
quasiquoting in types: The type @racket[`(a (1 b) ,String)]
|
||||
is expanded to @racket[(List 'a (List 1 'b) String)].
|
||||
|
||||
@examples[#:eval (eval-factory)
|
||||
(ann '(a (1 b) "foo")
|
||||
`(a (1 b) ,String))]
|
||||
|
||||
The @racket[quote], @racket[quasiquote], @racket[syntax] and
|
||||
@racket[quasisyntax] identifiers are interpreted specially within type
|
||||
expressions. The @racket[quote] identifier can be used to describe a type
|
||||
matching containing only the quoted value. Similarly, @racket[syntax] can be
|
||||
used to describe the type of the quoted syntax object, without the need to
|
||||
insert @racket[Syntaxof] by hand around each part of the type. Note that the
|
||||
type @racket[#'(a b c)] will match the syntax object @racket[#'(a b c)], but
|
||||
not the syntax object @tt{#'(a b . (c))}, i.e. the generated type is
|
||||
sensitive to the distinction between syntax pairs and syntax lists. It is
|
||||
possible that a future version of this library provides another type expander
|
||||
which accepts both. The @racket[quasiquote] and @racket[quasisyntax] forms
|
||||
allow the use of @racket[unquote] and @racket[unsyntax], respectively.
|
||||
|
||||
@subsection{Currying type expanders}
|
||||
|
||||
The @racket[curry] special type-expander form can be used to curry in some
|
||||
arguments to a type expander.
|
||||
|
||||
@examples[#:eval (eval-factory)
|
||||
(ann '([a . 1] [a . b] [a . "c"])
|
||||
(Let ([PA (curry Pairof 'a)])
|
||||
(List (PA 1) (PA 'b) (PA "c"))))]
|
||||
|
||||
@section{Common issues (FAQ)}
|
||||
|
||||
@(require (only-in scribble/eval interaction))
|
||||
@itemlist[
|
||||
@item{Explicitly requiring @racketmodname[typed/racket]
|
||||
causes an error:
|
||||
@(let ([errmsg (string-append "module: identifier already imported from"
|
||||
" a different source in:" "\n"
|
||||
" λ:" "\n"
|
||||
" type-expander" "\n"
|
||||
" typed/racket" "\n")])
|
||||
@interaction[(eval:alts (require typed/racket type-expander)
|
||||
(eval:result ""
|
||||
""
|
||||
errmsg))])
|
||||
A required module can shadow the definitions provided by
|
||||
the @litchar{#lang} language, but it cannot shadow the
|
||||
definitions provided by other explicitly required
|
||||
modules.
|
||||
|
||||
The solution is to avoid explicitly requiring
|
||||
@racketmodname[typed/racket], or to subtract from it the
|
||||
identifiers that would otherwise be shadowed anyway:
|
||||
|
||||
@racketblock[
|
||||
(require racket/require
|
||||
(subtract-in typed/racket type-expander)
|
||||
type-expander)]}
|
||||
@item{An error complains that a type expander is unbound:
|
||||
@(let ([errmsg (string-append "Type Checker: parse error in type;\n"
|
||||
" type name `foo' is unbound")])
|
||||
@interaction[(eval:alts (module main typed/racket
|
||||
(module m type-expander/lang
|
||||
(provide foo)
|
||||
(define-type-expander (foo stx) #'Void))
|
||||
(require 'm)
|
||||
(: v foo)
|
||||
(define v (void)))
|
||||
(eval:result ""
|
||||
""
|
||||
errmsg))])
|
||||
|
||||
This error will be raised if the @racketmodname[type-expander] library is not
|
||||
@racket[require]d. It is best to double-check that a
|
||||
@racket[(require type-expander)] form is present, and that it is present at
|
||||
the appropriate meta-level (it should be loaded at the same meta-level as the
|
||||
use of @racket[(: var type)], @racket[(define var : type value)]).
|
||||
|
||||
In the example above, the problem is that the module @racketid[main] requires
|
||||
@racket['m], but does not require @racketmodname[type-expander]. The @orig::
|
||||
in @racket[(#,orig:: #,(racketid v) #,(racketid foo))] therefore comes from
|
||||
@racketmodname[typed/racket], and does not know how to use the @racketid[foo]
|
||||
type expander.}
|
||||
@item{@bold{Q:} Can I write a recursive type-level
|
||||
function?
|
||||
|
||||
@bold{A:} Yes, but be sure that it is not infinitely
|
||||
recursive, as the expansion would never terminate, unlike
|
||||
@racketmodname[typed/racket]'s @racket[Rec], which allows
|
||||
truly recursive types.
|
||||
|
||||
Furthermore, it is best to ponder the risk of
|
||||
combinatorial explosion, for example in
|
||||
@racketmodname[typed/racket],
|
||||
@racket[((∀ (X) (List X X)) Number)] expands internally to
|
||||
the type @racket[(List Number Number)]. Nesting this
|
||||
pattern a few times will produce a type having an
|
||||
in-memory representation whose size is exponential in the
|
||||
size of the original type declaration. A type expander can
|
||||
easily produce a very large type, which will bring the
|
||||
type checker to a crawl and/or crash it.}]
|
||||
|
||||
@section{Overloaded @racketmodname[typed/racket] primitives}
|
||||
|
||||
|
||||
@defform[(unsafe-cast value type)]{
|
||||
We define an @racket[unsafe-cast] form which is not (yet) provided by
|
||||
Typed/Racket. It works like @racket[cast], but does not generate a predicate
|
||||
to check that the value is indeed of the given type. It can therefore be used
|
||||
to cast values to types for which @racket[cast] would fail at compile-time
|
||||
when trying to generate the predicate, for example function types, or any type
|
||||
which translates to a
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{chaperone}
|
||||
contract.}
|
||||
|
||||
@defform[(unsafe-cast/no-expand value type)]{
|
||||
Like @racket[unsafe-cast], but does not expand the type. Can be useful for
|
||||
types which are not completely handled by @racketmodname[type-expander], for
|
||||
example function types with filters.}
|
||||
|
||||
@(require (for-syntax racket/function racket/struct racket/vector))
|
||||
@(define-for-syntax (strip-loc e)
|
||||
(cond [(syntax? e) (datum->syntax e (strip-loc (syntax-e e)) #f)]
|
||||
[(pair? e) (cons (strip-loc (car e)) (strip-loc (cdr e)))]
|
||||
[(vector? e) (vector-map strip-loc e)]
|
||||
[(box? e) (box (strip-loc (unbox e)))]
|
||||
[(prefab-struct-key e)
|
||||
=> (λ (k) (apply make-prefab-struct
|
||||
k
|
||||
(strip-loc (struct->list e))))]
|
||||
[else e]))
|
||||
|
||||
@(define-syntax (ovl stx)
|
||||
(syntax-case stx ()
|
||||
[(_ name ...)
|
||||
(with-syntax ([(prefixed ...)
|
||||
(stx-map (λ (id) (format-id id "orig:~a" id))
|
||||
#'(name ...))]
|
||||
[(stripped-name ...)
|
||||
(stx-map strip-loc
|
||||
#'(name ...))]
|
||||
[(stripped-ooo ...)
|
||||
(stx-map (compose strip-loc stx-car stx-cdr)
|
||||
#'([name (... ...)] ...))])
|
||||
#'(list
|
||||
@defform[(stripped-name stripped-ooo)]{
|
||||
Overloaded version of @|prefixed| from
|
||||
@racketmodname[typed/racket].}
|
||||
...))]))
|
||||
|
||||
@ovl[
|
||||
:
|
||||
:type
|
||||
:print-type
|
||||
:query-type/args
|
||||
:query-type/result
|
||||
define-type
|
||||
define
|
||||
lambda
|
||||
λ
|
||||
case-lambda
|
||||
case-lambda:
|
||||
struct
|
||||
define-struct/exec
|
||||
ann
|
||||
cast
|
||||
inst
|
||||
let
|
||||
let*
|
||||
let-values
|
||||
make-predicate
|
||||
;;
|
||||
class]
|
||||
|
||||
@defidform[...*]{
|
||||
Overloaded version of @racketid[...*], which is interpreted specially by
|
||||
@racketmodname[typed/racket]. It seems to be equivalent to @racket[*] for
|
||||
indicating the type of a rest argument within a typed @orig:λ form.}
|
||||
|
||||
@section{Unimplemented @racketmodname[typed/racket]
|
||||
primitives (will be overloaded in later versions).}
|
||||
|
||||
@(define-syntax (ovl-todo stx)
|
||||
(syntax-case stx ()
|
||||
[(_ name ...)
|
||||
(with-syntax ([(prefixed ...)
|
||||
(stx-map (λ (id) (format-id id "orig:~a" id))
|
||||
#'(name ...))]
|
||||
[(stripped-name ...)
|
||||
(stx-map strip-loc
|
||||
#'(name ...))]
|
||||
[(stripped-ooo ...)
|
||||
(stx-map (compose strip-loc stx-car stx-cdr)
|
||||
#'([name (... ...)] ...))])
|
||||
#'(list
|
||||
@defform[(stripped-name stripped-ooo)]{
|
||||
Overloaded version of @|prefixed| from
|
||||
@racketmodname[typed/racket] (not implemented for the
|
||||
@racketmodname[type-expander] library yet, just throws an
|
||||
error).}
|
||||
...))]))
|
||||
|
||||
@ovl-todo[
|
||||
;; TODO: add all-defined-out in prims.rkt
|
||||
;; top-interaction.rkt
|
||||
;; case-lambda.rkt
|
||||
pcase-lambda:
|
||||
;; (submod "prims-contract.rkt" forms)
|
||||
require/opaque-type
|
||||
;require-typed-struct-legacy
|
||||
require-typed-struct
|
||||
;require/typed-legacy
|
||||
require/typed
|
||||
require/typed/provide
|
||||
require-typed-struct/provide
|
||||
;cast
|
||||
define-predicate
|
||||
;; prims.rkt
|
||||
define-type-alias
|
||||
define-new-subtype
|
||||
define-typed-struct
|
||||
define-typed-struct/exec
|
||||
define-struct:
|
||||
define-struct
|
||||
struct:
|
||||
λ:
|
||||
lambda:
|
||||
letrec
|
||||
letrec-values
|
||||
let/cc
|
||||
let/ec
|
||||
let:
|
||||
let*:
|
||||
letrec:
|
||||
let-values:
|
||||
letrec-values:
|
||||
let/cc:
|
||||
let/ec:
|
||||
for
|
||||
for/list
|
||||
for/vector
|
||||
for/hash
|
||||
for/hasheq
|
||||
for/hasheqv
|
||||
for/and
|
||||
for/or
|
||||
for/sum
|
||||
for/product
|
||||
for/lists
|
||||
for/first
|
||||
for/last
|
||||
for/fold
|
||||
for*
|
||||
for*/list
|
||||
for*/lists
|
||||
for*/vector
|
||||
for*/hash
|
||||
for*/hasheq
|
||||
for*/hasheqv
|
||||
for*/and
|
||||
for*/or
|
||||
for*/sum
|
||||
for*/product
|
||||
for*/first
|
||||
for*/last
|
||||
for*/fold
|
||||
for/set
|
||||
for*/set
|
||||
do
|
||||
do:
|
||||
with-handlers
|
||||
define-struct/exec:]
|
||||
|
||||
@include-section{deprecated-colon.scrbl}
|
||||
5
test/base-lang-test-1.rkt
Normal file
5
test/base-lang-test-1.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang type-expander/base
|
||||
(require typed/rackunit)
|
||||
(check-equal? (ann (add1 1)
|
||||
(Let ([T Number]) T))
|
||||
2)
|
||||
7
test/base-lang-test-2.rkt
Normal file
7
test/base-lang-test-2.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(module m type-expander/base
|
||||
(require typed/rackunit)
|
||||
(check-equal? (ann (add1 1)
|
||||
(Let ([T Number]) T))
|
||||
2))
|
||||
5
test/base-lang-test-3.rkt
Normal file
5
test/base-lang-test-3.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang type-expander/base
|
||||
(require typed/rackunit)
|
||||
(check-equal? (ann (add1 1)
|
||||
(Let ([T Number]) T))
|
||||
2)
|
||||
5
test/lang-test-1.rkt
Normal file
5
test/lang-test-1.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang type-expander
|
||||
(require typed/rackunit)
|
||||
(check-equal? (ann (add1 1)
|
||||
(Let ([T Number]) T))
|
||||
2)
|
||||
7
test/lang-test-2.rkt
Normal file
7
test/lang-test-2.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(module m type-expander/lang
|
||||
(require typed/rackunit)
|
||||
(check-equal? (ann (add1 1)
|
||||
(Let ([T Number]) T))
|
||||
2))
|
||||
5
test/lang-test-3.rkt
Normal file
5
test/lang-test-3.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang type-expander/lang
|
||||
(require typed/rackunit)
|
||||
(check-equal? (ann (add1 1)
|
||||
(Let ([T Number]) T))
|
||||
2)
|
||||
20
test/readme.rkt
Normal file
20
test/readme.rkt
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
#lang typed/racket
|
||||
(require type-expander
|
||||
typed/rackunit
|
||||
(for-syntax racket/list))
|
||||
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n)
|
||||
#`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(: five-strings (→ String (Repeat String 5)))
|
||||
(define (five-strings x)
|
||||
(list x "a" "b" "c" "d"))
|
||||
|
||||
(check-equal? (five-strings "hello")
|
||||
'("hello" "a" "b" "c" "d"))
|
||||
|
||||
(check-equal? (ann (five-strings "moon") (Repeat String 5))
|
||||
'("moon" "a" "b" "c" "d"))
|
||||
746
test/type-expander-test.rkt
Normal file
746
test/type-expander-test.rkt
Normal file
|
|
@ -0,0 +1,746 @@
|
|||
#lang typed/racket
|
||||
|
||||
(require type-expander
|
||||
typed/rackunit
|
||||
(for-syntax type-expander/expander
|
||||
racket/list
|
||||
version/utils
|
||||
rackunit
|
||||
syntax/parse))
|
||||
|
||||
; Tests for expand-type
|
||||
(begin
|
||||
;; Test harness:
|
||||
(begin
|
||||
(define-syntax (test-expander stx)
|
||||
(syntax-parse stx
|
||||
[(_ type expanded-type)
|
||||
(let ([actual (syntax->datum (expand-type #'type))]
|
||||
[expected (syntax->datum #'expanded-type)])
|
||||
(unless (equal? actual expected)
|
||||
(raise-syntax-error
|
||||
'test-expander
|
||||
(format "test-expander failed: expected ~a, got ~a"
|
||||
expected
|
||||
actual)
|
||||
stx
|
||||
#'type))
|
||||
#`(check-equal? '#,actual
|
||||
'#,expected))])))
|
||||
|
||||
; Simple identity expander test, with a different case when used as a
|
||||
; simple identifier.
|
||||
|
||||
(begin
|
||||
(define-type-expander (id stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t) #'t]
|
||||
[x #'(∀ (A) (→ A A))]))
|
||||
|
||||
(test-expander (id Number) Number)
|
||||
(test-expander id (∀ (A) (→ A A))))
|
||||
|
||||
(begin
|
||||
(define-type-expander (double stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t) #'(id (Pairof (id t) t))]))
|
||||
|
||||
(test-expander (∀ (A) (→ A (id (double (id A)))))
|
||||
(∀ (A) (→ A (Pairof A A))))
|
||||
|
||||
(test-expander (→ Any Boolean : (double (id A)))
|
||||
(→ Any Boolean : (Pairof A A))))
|
||||
|
||||
;; Curry expander arguments:
|
||||
(begin
|
||||
(define-type-expander (CPairof stx)
|
||||
(syntax-case stx ()
|
||||
[(_ a) #'(curry Pairof a)]
|
||||
[(_ a b) #'(Pairof a b)]))
|
||||
|
||||
(test-expander (CPairof Number String)
|
||||
(Pairof Number String))
|
||||
|
||||
(test-expander ((CPairof Number) String)
|
||||
(Pairof Number String))
|
||||
|
||||
(check-equal? (ann (ann '(1 . "b") (CPairof Number String))
|
||||
(Pairof Number String))
|
||||
'(1 . "b"))
|
||||
|
||||
(check-equal? (ann (ann '(1 . "c") ((CPairof Number) String))
|
||||
(Pairof Number String))
|
||||
'(1 . "c")))
|
||||
|
||||
;; Shadowing with ∀ variables:
|
||||
(begin
|
||||
(test-expander (∀ (id) (→ id))
|
||||
(∀ (id) (→ id)))
|
||||
(test-expander (∀ (id2) (→ id))
|
||||
(∀ (id2) (→ (∀ (A) (→ A A))))))
|
||||
|
||||
(begin
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(test-expander (Repeat Number 5)
|
||||
(List Number Number Number Number Number)))
|
||||
|
||||
(begin
|
||||
(: count-five-more (→ Number (Repeat Number 5)))
|
||||
(define (count-five-more x)
|
||||
(list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5)))
|
||||
|
||||
(check-equal? (count-five-more 3)
|
||||
'(4 5 6 7 8))
|
||||
(check-equal? (ann (count-five-more 15) (Repeat Number 5))
|
||||
'(16 17 18 19 20)))
|
||||
|
||||
;; Shadowing with Rec variables:
|
||||
|
||||
(begin
|
||||
(: repeat-shadow (→ Number (Rec Repeat (U Null (List Number Repeat)))))
|
||||
(define (repeat-shadow n)
|
||||
(if (= n 0)
|
||||
'()
|
||||
(list n (repeat-shadow (sub1 n)))))
|
||||
(check-equal? (repeat-shadow 5)
|
||||
'(5 (4 (3 (2 (1 ()))))))
|
||||
(test-expander (→ Number (Rec Repeat (U Null (List Number Repeat))))
|
||||
(→ Number (Rec Repeat (U Null (List Number Repeat))))))
|
||||
|
||||
;; Shadowing with Let:
|
||||
|
||||
(begin
|
||||
(let ()
|
||||
(define-type-expander (exp stx)
|
||||
#'(List 1 2 3))
|
||||
|
||||
(define-type e String)
|
||||
(: x (List e (Let ([e exp]) e)))
|
||||
(define x (list "e1" (list 1 2 3)))
|
||||
(check-equal? x '("e1" (1 2 3)))
|
||||
(test-expander (List e (Let ([e exp]) e))
|
||||
(List e (List 1 2 3)))
|
||||
|
||||
(: y (List e))
|
||||
(define y (list "e2"))
|
||||
(check-equal? y '("e2"))
|
||||
(test-expander (List e)
|
||||
(List e))
|
||||
(void)))
|
||||
|
||||
;; Let, Λ and ∀
|
||||
(begin
|
||||
(let ()
|
||||
(define-type-expander Str1 (λ (_) #'String))
|
||||
|
||||
(test-expander (Let ([Number Str1]) Number)
|
||||
String)
|
||||
(test-expander (Let ([Number (Λ stx #'String)]) (Number))
|
||||
String)
|
||||
(test-expander (Let ([Number (Λ stx #'Str1)]) (Number))
|
||||
String)
|
||||
(test-expander (Let ([Number (Λ stx #'String)]) Number)
|
||||
String)
|
||||
|
||||
(test-expander ((∀ (A) (Pairof A A)) Number)
|
||||
(Pairof Number Number))
|
||||
(test-expander (Let ([String (∀ (A) (Pairof A A))])
|
||||
(String Number))
|
||||
(Pairof Number Number))
|
||||
|
||||
(test-expander (Let ([Poly-Repeat
|
||||
(Λ (_ n)
|
||||
#`(∀ (A)
|
||||
(List #,@(map (λ (_) #'A)
|
||||
(range (syntax-e #'n))))))]
|
||||
[Number String])
|
||||
((Poly-Repeat 5) Number))
|
||||
(List String String String String String))
|
||||
|
||||
(test-expander (Let ([Poly-Repeat
|
||||
(Λ (_ n)
|
||||
#`(∀ (A)
|
||||
(List #,@(map (λ (_) #'A)
|
||||
;; like above, but also works
|
||||
;; without the syntax-e here:
|
||||
(range n)))))]
|
||||
[Number String])
|
||||
((Poly-Repeat 5) Number))
|
||||
(List String String String String String))
|
||||
|
||||
(ann '(1 . "b") ((Let ([Foo String])
|
||||
(∀ (ty)
|
||||
(Pairof ty Foo)))
|
||||
Integer))
|
||||
|
||||
(test-expander ((∀ (A1)
|
||||
(Let ()
|
||||
(Let ()
|
||||
(Let ()
|
||||
(Let ()
|
||||
A1)))))
|
||||
Number)
|
||||
Number)
|
||||
|
||||
(void)))
|
||||
|
||||
;; Let*, Letrec
|
||||
(let ()
|
||||
(test-expander
|
||||
(Letrec ([Poly-Repeat
|
||||
(Λ (_ n)
|
||||
(if (= 0 n)
|
||||
#'(∀ (A) Null)
|
||||
#`(∀ (A)
|
||||
(Pairof A
|
||||
((Poly-Repeat #,(sub1 n)) A)))))]
|
||||
[Number String])
|
||||
((Poly-Repeat 5) Number))
|
||||
(Pairof String
|
||||
(Pairof String
|
||||
(Pairof String
|
||||
(Pairof String
|
||||
(Pairof String Null))))))
|
||||
|
||||
#;(test-expander (Let* ([String Number]
|
||||
[Number String])
|
||||
(List Number String))
|
||||
(List Number Number))
|
||||
(void)))
|
||||
|
||||
;; Test ":"
|
||||
(begin
|
||||
(: c0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d))
|
||||
(define c0 '(2 "abc" #,(x . z) #(1 "b" x) d))
|
||||
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(: x (→ (Repeat Number 5)))
|
||||
(define (x) (list 1 2 3 4 5))
|
||||
(check-equal? (x) '(1 2 3 4 5))))
|
||||
|
||||
;; Test define-type
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(define-type R5 (Repeat Number 5))
|
||||
(check-equal? (ann '(1 2 3 4 5) R5) '(1 2 3 4 5)))
|
||||
|
||||
;; Test define
|
||||
(begin
|
||||
(define d0
|
||||
: `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)
|
||||
'(2 "abc" #,(x . z) #(1 "b" x) d))
|
||||
(check-equal? (ann d0 (List 2
|
||||
"abc"
|
||||
(List 'unsyntax
|
||||
(Pairof (U 'x 'y) (U 'y 'z)))
|
||||
(Vector 1 "b" 'x) 'd))
|
||||
'(2 "abc" (unsyntax (x . z)) #(1 "b" x) d))
|
||||
|
||||
(: d1 (→ Number (→ Number Number)))
|
||||
(define ((d1 [x : Number]) [y : Number]) : Number (+ x y))
|
||||
(check-equal? (ann ((d1 2) 3) Number) 5)
|
||||
|
||||
(: d2 (→ Number (→ Number Number)))
|
||||
(define ((d2 [x : Number]) [y : Number]) (+ x y))
|
||||
(check-equal? (ann ((d2 3) 4) Number) 7)
|
||||
|
||||
(define #:∀ (T) ((d3 [x : T]) [y : T]) : (Pairof T T) (cons x y))
|
||||
(check-equal? (ann ((d3 'x) 'y) (Pairof Symbol Symbol)) '(x . y)))
|
||||
|
||||
;; Test lambda
|
||||
(begin
|
||||
(check-equal? ((ann (lambda ([x : Number]) : Number (* x 2))
|
||||
(→ Number Number))
|
||||
3)
|
||||
6)
|
||||
(check-equal? ((ann (λ ([x : Number]) : Number (* x 2))
|
||||
(→ Number Number))
|
||||
3)
|
||||
6)
|
||||
(check-equal? ((λ x x) 1 2 3) '(1 2 3))
|
||||
(check-equal? ((λ #:∀ (A) [x : A ...*] : (Listof A) x) 1 2 3) '(1 2 3))
|
||||
(check-equal? ((λ [x : Number ...*] : (Listof Number) x) 1 2 3) '(1 2 3))
|
||||
(check-not-exn (λ ()
|
||||
(ann (λ #:∀ (A) [x : A ...*] : (Listof A) x)
|
||||
(∀ (A) (→ A * (Listof A))))))
|
||||
(check-not-exn (λ ()
|
||||
(ann (λ #:∀ (A) [x : A *] : (Listof A) x)
|
||||
(∀ (A) (→ A * (Listof A))))))
|
||||
(check-not-exn (λ ()
|
||||
(ann (λ #:∀ (A ...) ([l : (List A ... A)]) : (List A ... A)
|
||||
l)
|
||||
(∀ (A ...) (→ (List A ... A) (List A ... A))))))
|
||||
(check-not-exn (λ ()
|
||||
(ann (λ #:∀ (A ...) [l : (List A ... A) *]
|
||||
: (Listof (List A ... A))
|
||||
l)
|
||||
(∀ (A ...) (→ (List A ... A) *
|
||||
(Listof (List A ... A)))))))
|
||||
(check-not-exn (λ ()
|
||||
(ann (λ #:∀ (A ...) [l : (List A ... A) ...*]
|
||||
: (Listof (List A ... A))
|
||||
l)
|
||||
(∀ (A ...) (→ (List A ... A) *
|
||||
(Listof (List A ... A))))))))
|
||||
|
||||
;; Test struct
|
||||
(begin
|
||||
(struct s0 ())
|
||||
(struct s1 ([x : Number]))
|
||||
(struct s2 ([x : Number] [y : Number]))
|
||||
(struct s3 ([x : Number] [y : Number]) #:transparent)
|
||||
(struct s4 () #:transparent)
|
||||
(struct (A B) s5 ([x : A] [y : B]) #:transparent)
|
||||
(struct (A B) s6 () #:transparent)
|
||||
(struct s7 s2 ([z : String]) #:transparent)
|
||||
(struct (A) s8 s3 ([z : A]) #:transparent)
|
||||
(struct (A B C) s9 s5 ([z : C]) #:transparent)
|
||||
(struct (A B C) s10 s2 ([z : C]) #:transparent)
|
||||
(struct (A B C) s11 s5 ([z : C]))
|
||||
|
||||
(check (λ (a b) (not (equal? a b))) (s0) (s0))
|
||||
(check-equal? (s1-x (s1 123)) 123)
|
||||
(check-equal? (s2-x (s2 2 3)) 2)
|
||||
(check-equal? (s2-y (s2 2 3)) 3)
|
||||
(check-equal? (s3-x (s3 4 5)) 4)
|
||||
(check-equal? (s3-y (s3 4 5)) 5)
|
||||
(check-equal? (s4) (s4))
|
||||
(check-equal? (s5-x (s5 6 7)) 6)
|
||||
(check-equal? (s5-y (s5 6 7)) 7)
|
||||
(check-equal? (s5 6 7) (s5 6 7))
|
||||
(check-equal? ((inst s5 Number String) 6 "g") (s5 6 "g"))
|
||||
(check-equal? (s6) (s6))
|
||||
(check-equal? ((inst s6 Number String)) (s6))
|
||||
|
||||
;(check-equal? (s7-x (s7 -1 -2 "c") -1))
|
||||
;(check-equal? (s7-y (s7 -1 -2 "c") -2))
|
||||
(check-equal? (s7-z (s7 -1 -2 "c")) "c")
|
||||
(check-equal? (s2-x (s7 -1 -2 "c")) -1)
|
||||
(check-equal? (s2-y (s7 -1 -2 "c")) -2)
|
||||
(check-not-equal? (s7 -1 -2 "c") (s7 -1 -2 "c"))
|
||||
(check-not-exn (λ () (ann (s7 -1 -2 "c") s2)))
|
||||
(check-true (s2? (s7 -1 -2 "c")))
|
||||
|
||||
;(check-equal? (s8-x (s8 -1 -2 "c") -1))
|
||||
;(check-equal? (s8-y (s8 -1 -2 "c") -2))
|
||||
(check-equal? (s8-z (s8 -1 -2 "c")) "c")
|
||||
(check-equal? (s3-x (s8 -1 -2 "c")) -1)
|
||||
(check-equal? (s3-y (s8 -1 -2 "c")) -2)
|
||||
(check-equal? (s8 -1 -2 "c") (s8 -1 -2 "c"))
|
||||
(check-equal? ((inst s8 String) -1 -2 "c") (s8 -1 -2 "c"))
|
||||
(check-not-exn (λ () (ann ((inst s8 String) -1 -2 "c") s3)))
|
||||
(check-true (s3? ((inst s8 String) -1 -2 "c")))
|
||||
|
||||
;(check-equal? (s9-x (s9 8 9 10)) 8)
|
||||
;(check-equal? (s9-y (s9 8 9 10)) 9)
|
||||
(check-equal? (s9-z (s9 8 9 10)) 10)
|
||||
(check-equal? (s5-x (s9 8 9 10)) 8)
|
||||
(check-equal? (s5-y (s9 8 9 10)) 9)
|
||||
(check-equal? (s9 8 9 10) (s9 8 9 10))
|
||||
;; Bug https://github.com/racket/typed-racket/issues/451
|
||||
;(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
|
||||
; (Struct s5))))
|
||||
(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
|
||||
(Struct (s5 Number Symbol)))))
|
||||
(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
|
||||
(s5 Number Symbol))))
|
||||
(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j")
|
||||
(s5 Any Any))))
|
||||
(check-true (s5? ((inst s9 Number Symbol String) -1 'i "j")))
|
||||
(check-not-equal? (s10 11 12 13) (s10 11 12 13))
|
||||
(check-not-equal? (s11 14 15 16) (s11 14 15 16)))
|
||||
|
||||
;; Test define-struct/exec
|
||||
(begin
|
||||
(define-struct/exec se0 ()
|
||||
;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
|
||||
[(λ (self v) (cons self v)) : (→ se0 Any (Pairof se0 Any))])
|
||||
(define-struct/exec se1 ([x : Number])
|
||||
;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
|
||||
[(λ (self v) (cons self v)) : (→ se1 Any (Pairof se1 Any))])
|
||||
(define-struct/exec se2 ([x : Number] [y : Number])
|
||||
[(λ (self v) (cons self v)) : (→ se2 Any (Pairof se2 Any))])
|
||||
(define-struct/exec (se3 se2) ([z : String])
|
||||
[(λ (self v w) (list self v w))
|
||||
;: (∀ (A B) (→ se3 A B (List se2 A B)))])
|
||||
: (→ se3 Any Any (List se2 Any Any))])
|
||||
(define-struct/exec (se4 se2) ([z : String])
|
||||
[(λ (self v w) (list self v w))
|
||||
;: (∀ (A B) (→ se4 A B (List se2 A B)))])
|
||||
: (→ se4 Any (→ Number Number) (List se2 Any (→ Number Number)))])
|
||||
|
||||
(check (λ (a b) (not (equal? a b))) (se0) (se0))
|
||||
(check-equal? (cdr ((se0) 'a)) 'a)
|
||||
(check-not-exn (λ () (ann (car ((se0) 'a)) se0)))
|
||||
(check-true (se0? (car ((se0) 'a))))
|
||||
|
||||
(check (λ (a b) (not (equal? a b))) (se1 123) (se1 123))
|
||||
(check-equal? (se1-x (se1 123)) 123)
|
||||
(check-equal? (se1-x (car ((se1 123) 'b))) 123)
|
||||
(check-equal? (cdr ((se1 123) 'b)) 'b)
|
||||
(check-not-exn (λ () (ann (car ((se1 123) 'b)) se1)))
|
||||
(check-true (se1? (car ((se1 123) 'b))))
|
||||
|
||||
(check (λ (a b) (not (equal? a b))) (se2 2 3) (se2 2 3))
|
||||
(check-equal? (se2-x (se2 2 3)) 2)
|
||||
(check-equal? (se2-y (se2 2 3)) 3)
|
||||
(check-equal? (se2-x (car ((se2 2 3) 'c))) 2)
|
||||
(check-equal? (se2-y (car ((se2 2 3) 'c))) 3)
|
||||
(check-equal? (cdr ((se2 2 3) 'c)) 'c)
|
||||
(check-not-exn (λ () (ann (car ((se2 2 3) 'c)) se2)))
|
||||
(check-true (se2? (car ((se2 2 3) 'c))))
|
||||
|
||||
(check (λ (a b) (not (equal? a b))) (se3 4 5 "f") (se3 4 5 "f"))
|
||||
(check-equal? (se2-x (se3 4 5 "f")) 4)
|
||||
(check-equal? (se2-y (se3 4 5 "f")) 5)
|
||||
(check-equal? (se3-z (se3 4 5 "f")) "f")
|
||||
(check-equal? (se2-x (car ((se3 4 5 "f") 'd 'e))) 4)
|
||||
(check-equal? (se2-y (car ((se3 4 5 "f") 'd 'e))) 5)
|
||||
(check-equal? (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))])
|
||||
(if (se3? ret)
|
||||
(se3-z ret)
|
||||
"wrong type!"))
|
||||
"f")
|
||||
(check-equal? (cadr ((se3 4 5 "f") 'd 'e)) 'd)
|
||||
(check-equal? (caddr ((se3 4 5 "f") 'd 'e)) 'e)
|
||||
(check-equal? ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12)
|
||||
24)
|
||||
(check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2)))
|
||||
(check-true (se2? (car ((se3 4 5 "f") 'd 'e))))
|
||||
(check-true (se3? (car ((se3 4 5 "f") 'd 'e)))))
|
||||
|
||||
;; Test ann
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
(check-equal? (ann (ann '(1 2 3)
|
||||
(Repeat Number 3))
|
||||
(List Number Number Number))
|
||||
'(1 2 3)))
|
||||
|
||||
;; Test inst
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(: f (∀ (A B C D) (→ (Pairof A B) (Pairof C D) (List A C B D))))
|
||||
(define (f x y) (list (car x) (car y) (cdr x) (cdr y)))
|
||||
|
||||
(check-equal? ((inst f
|
||||
(Repeat Number 3)
|
||||
(Repeat String 2)
|
||||
(Repeat 'x 1)
|
||||
(Repeat undefined-type 0))
|
||||
'((1 2 3) . ("a" "b"))
|
||||
'((x) . ()))
|
||||
'((1 2 3) (x) ("a" "b") ())))
|
||||
|
||||
;; Test let
|
||||
(begin
|
||||
(check-equal? (ann (let loop-id ([x 1])
|
||||
(if (equal? x 2)
|
||||
x
|
||||
(loop-id 2)))
|
||||
Any)
|
||||
2)
|
||||
(check-equal? (let () 'x) 'x)
|
||||
(check-equal? (ann (let #:∀ (T) ([a : T 3]
|
||||
[b : (Pairof T T) '(5 . 7)])
|
||||
(cons a b))
|
||||
(Pairof Number (Pairof Number Number)))
|
||||
'(3 5 . 7)))
|
||||
|
||||
;; Test let*
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(check-equal? (let* ([x* : (Repeat Number 3) '(1 2 3)]
|
||||
[y* : (Repeat Number 3) x*])
|
||||
y*)
|
||||
'(1 2 3)))
|
||||
|
||||
;; Test let-values
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
|
||||
(check-equal? (ann (let-values
|
||||
([([x : (Repeat Number 3)])
|
||||
(list 1 2 3)])
|
||||
(cdr x))
|
||||
(List Number Number))
|
||||
'(2 3))
|
||||
|
||||
(check-equal? (ann (let-values
|
||||
([([x : (Repeat Number 3)] [y : Number])
|
||||
(values (list 1 2 3) 4)])
|
||||
(cons y x))
|
||||
(Pairof Number (List Number Number Number)))
|
||||
'(4 . (1 2 3)))
|
||||
|
||||
(check-equal? (ann (let-values
|
||||
([(x y)
|
||||
(values (list 1 2 3) 4)])
|
||||
(cons y x))
|
||||
(Pairof Number (List Number Number Number)))
|
||||
'(4 . (1 2 3))))
|
||||
|
||||
;; Test make-predicate
|
||||
(let ()
|
||||
(define-type-expander (Repeat stx)
|
||||
(syntax-case stx ()
|
||||
[(_ t n) #`(List #,@(map (λ (x) #'t)
|
||||
(range (syntax->datum #'n))))]))
|
||||
(check-equal? ((make-predicate (Repeat Number 3)) '(1 2 3)) #t)
|
||||
(check-equal? ((make-predicate (Repeat Number 3)) '(1 "b" 3)) #f))
|
||||
|
||||
;; row-inst
|
||||
(let-syntax ([when-row-inst-is-defined
|
||||
(λ (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ body)
|
||||
(if (or (identifier-binding #'row-inst)
|
||||
(version<=? "6.7" (version)))
|
||||
#'body
|
||||
#'(void))]))])
|
||||
(when-row-inst-is-defined
|
||||
(let ()
|
||||
;; Example taken from the docs
|
||||
(: id (All (r #:row)
|
||||
(-> (Class #:row-var r) (Class #:row-var r))))
|
||||
(define (id cls) cls)
|
||||
(define result ((row-inst id (Row (field [x Integer])))
|
||||
(class object% (super-new) (field [x : Integer 0]))))
|
||||
(ann result (Class (field (x Integer))))
|
||||
(void))))
|
||||
|
||||
;; Tests written while debugging
|
||||
(begin
|
||||
(let ()
|
||||
(define-type-expander flob
|
||||
(λ (stx) #'(All (abc) (List abc))))
|
||||
|
||||
(ann '(a) ((flob) Symbol))
|
||||
|
||||
(ann '(42) ((Let ([flob (Λ (_ arg)
|
||||
#'((∀ (abc)
|
||||
(List abc)) arg))])
|
||||
flob)
|
||||
Integer))
|
||||
|
||||
(ann '(1 2 3) ((∀ (abc)
|
||||
(Listof abc))
|
||||
Integer))
|
||||
|
||||
(ann '(1 2 3) ((Let ()
|
||||
(∀ (abc)
|
||||
(Listof abc)))
|
||||
Integer))
|
||||
(void))
|
||||
|
||||
(let ()
|
||||
(test-expander
|
||||
((Let () (∀ (A1) (Let () A1))) Number)
|
||||
Number))
|
||||
|
||||
(let ()
|
||||
(ann '(1 2 3) (Listof Integer))
|
||||
|
||||
(define-type (poly1 ty)
|
||||
(Listof ty))
|
||||
|
||||
(ann '(1 2 3) (poly1 Integer))
|
||||
|
||||
(define-type poly2
|
||||
(∀ (ty)
|
||||
(Listof ty)))
|
||||
|
||||
(ann '(1 2 3) (poly2 Integer))
|
||||
|
||||
(ann '(1 2 3) ((∀ (ty)
|
||||
(Listof ty))
|
||||
Integer))
|
||||
|
||||
(ann '(1 2 3) ((Let ()
|
||||
(∀ (ty)
|
||||
(Listof ty)))
|
||||
Integer))
|
||||
|
||||
(void))
|
||||
|
||||
(define-for-syntax (test-use/def stx def expected-use expected-def)
|
||||
(let ([actual-use (syntax->datum
|
||||
(apply-type-expander (datum->syntax stx 'Quux)
|
||||
(datum->syntax stx 'Quux)))]
|
||||
[actual-def (syntax->datum
|
||||
(apply-type-expander def def))])
|
||||
(check-equal? actual-use expected-use)
|
||||
(check-equal? actual-def expected-def)))
|
||||
|
||||
(let ()
|
||||
(define-type-expander (Foo stx) #'Integer)
|
||||
(define-type-expander (Bar stx) #'Integer)
|
||||
(define-type-expander (Quux stx) #'Integer)
|
||||
|
||||
(define-type mytype1
|
||||
(Let ([Foo (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'Integer 'Integer)
|
||||
#'T)])
|
||||
(Foo Quux)))
|
||||
|
||||
(define-type mytype23
|
||||
(Let ([Quux String])
|
||||
(Let ([Foo (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'String 'String)
|
||||
#'T)])
|
||||
(Foo (∀ (A)
|
||||
(Let ([Bar (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'String 'String)
|
||||
#'T)])
|
||||
(Bar (Listof A))))))))
|
||||
|
||||
(define-type mytype45
|
||||
(Let ([Foo (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'String 'Integer)
|
||||
#'T)])
|
||||
(Let ([Quux String])
|
||||
(Foo (∀ (A)
|
||||
(Let ([Bar (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'String 'String)
|
||||
#'T)])
|
||||
(Bar (Listof A))))))))
|
||||
|
||||
(define-type mytype67
|
||||
(Let ([Foo (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'Integer 'Integer)
|
||||
#'T)])
|
||||
(Foo (Let ([Quux String])
|
||||
(∀ (A)
|
||||
(Let ([Bar (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'String 'String)
|
||||
#'T)])
|
||||
(Bar (Listof A))))))))
|
||||
|
||||
(define-type mytype89
|
||||
(Let ([Foo (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'Integer 'Integer)
|
||||
#'T)])
|
||||
(Foo (∀ (A)
|
||||
(Let ([Quux String])
|
||||
(Let ([Bar (Λ (_ T)
|
||||
(test-use/def #'T #'Quux 'String 'String)
|
||||
#'T)])
|
||||
(Bar (Listof A))))))))
|
||||
|
||||
(void))
|
||||
|
||||
(let ()
|
||||
(test-expander ((Let ([F (Λ (_ T) #'T)]) F) String)
|
||||
String)
|
||||
(test-expander ((Let ([F (Λ (_ T) #'(List T))]) F) String)
|
||||
(List String)))
|
||||
|
||||
;; Please don't ever do that in practice :) !
|
||||
(let ()
|
||||
(test-expander (Let ([Loot Number])
|
||||
((Let ([Loot Let]) Loot) ([AAA Number])
|
||||
AAA))
|
||||
Number)
|
||||
(test-expander (Let ([Loot Number])
|
||||
((Let ([Loot Let]) Loot) ([Let Loot])
|
||||
Let))
|
||||
Number)
|
||||
(test-expander (Let ([Loot Number])
|
||||
((Let ([Loot Let]) Loot) ([Loot String])
|
||||
Loot))
|
||||
String)))
|
||||
|
||||
;; more tests
|
||||
(begin
|
||||
(test-expander ((∀ (A) ((∀ (A) ((∀ (A) ((∀ (A) A) A)) A)) A)) Number)
|
||||
Number)
|
||||
(test-expander (Let ([A Number])
|
||||
(Let ([A A])
|
||||
(Let ([A A])
|
||||
(Let ([A A])
|
||||
A))))
|
||||
Number)
|
||||
(test-expander (Let* ([A Number]
|
||||
[A A]
|
||||
[A A]
|
||||
[A A]
|
||||
[A A])
|
||||
A)
|
||||
Number)
|
||||
(test-expander (Let* ([A Number]
|
||||
[A (List A)]
|
||||
[A (Pairof A A)]
|
||||
[A (Vector A)]
|
||||
[A (Set A)])
|
||||
A)
|
||||
(Set (Vector (Pairof (List Number) (List Number)))))
|
||||
|
||||
;; Adjusted from http://www.cs.utah.edu/~mflatt/scope-sets/
|
||||
;; #%28part._.Macro_.Definitions_in_a_.Recursive_.Scope%29
|
||||
(test-expander (Letrec ([Identity (Λ (_ misc-id)
|
||||
#'(∀ (X)
|
||||
(Let ([misc-id String])
|
||||
X)))])
|
||||
((Identity X) Number))
|
||||
Number)
|
||||
(test-expander (Letrec ([Identity (Λ (_ misc-id)
|
||||
#'(∀ (misc-id)
|
||||
(Let ([X String])
|
||||
misc-id)))])
|
||||
((Identity X) Number))
|
||||
Number)
|
||||
(test-expander (Letrec ([GetY (Λ (_ misc-id)
|
||||
(datum->syntax #'misc-id 'Y))])
|
||||
(Let ([Y Number]) (GetY X)))
|
||||
Number)
|
||||
(test-expander (Letrec ([GetY (Λ (_ misc-id)
|
||||
(datum->syntax #'misc-id 'Y))])
|
||||
((∀ (Y) (GetY X)) Number))
|
||||
Number))
|
||||
|
||||
;; Tests for Syntax
|
||||
(let ()
|
||||
(test-expander #'a (Syntaxof 'a))
|
||||
(test-expander #'(a) (Syntaxof (List (Syntaxof 'a))))
|
||||
(test-expander #'(a . b) (Syntaxof (Pairof (Syntaxof 'a) (Syntaxof 'b))))
|
||||
(test-expander #'(a . (b))
|
||||
(Syntaxof (Pairof (Syntaxof 'a)
|
||||
(Syntaxof (List (Syntaxof 'b))))))
|
||||
(test-expander #'(a b) (Syntaxof (List (Syntaxof 'a) (Syntaxof 'b))))
|
||||
(test-expander #'(a b . c)
|
||||
(Syntaxof (List* (Syntaxof 'a) (Syntaxof 'b) (Syntaxof 'c))))
|
||||
(test-expander #'(a b . (c))
|
||||
(Syntaxof (List* (Syntaxof 'a)
|
||||
(Syntaxof 'b)
|
||||
(Syntaxof (List (Syntaxof 'c)))))))
|
||||
|
||||
;; Small typo
|
||||
(let ()
|
||||
(test-expander ((No-Expand List) 'a 'b) (List 'a 'b)))
|
||||
1977
type-expander.hl.rkt
Normal file
1977
type-expander.hl.rkt
Normal file
File diff suppressed because it is too large
Load Diff
13
utils.rkt
Normal file
13
utils.rkt
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
#lang typed/racket
|
||||
|
||||
(require (for-syntax syntax/parse))
|
||||
|
||||
(provide define-syntax/parse)
|
||||
|
||||
;; Copied from phc-toolkit, but does not bind "stx". Use this-syntax
|
||||
;; instead, from syntax/parse.
|
||||
(define-syntax-rule (define-syntax/parse (name . args) body0 . body)
|
||||
(define-syntax (name stx2)
|
||||
;(with-backtrace (syntax->datum stx2)
|
||||
(syntax-parse stx2
|
||||
[(_ . args) body0 . body])))
|
||||
Loading…
Reference in New Issue
Block a user