├── .gitmodules ├── .gitignore ├── lang ├── reader.rkt ├── lang │ └── reader.rkt └── main.rkt ├── base └── lang │ └── reader.rkt ├── lang.rkt ├── test ├── lang-test-1.rkt ├── lang-test-3.rkt ├── base-lang-test-1.rkt ├── base-lang-test-3.rkt ├── lang-test-2.rkt ├── base-lang-test-2.rkt ├── readme.rkt ├── test-contracts-to-types.rkt └── type-expander-test.rkt ├── dbg.rkt ├── main.rkt ├── base.rkt ├── expander.rkt ├── utils.rkt ├── scribblings ├── type-expander-implementation.scrbl ├── deprecated-colon.scrbl ├── contracts-to-types.scrbl └── type-expander.scrbl ├── licenses ├── bsd.txt └── lgpl-3.0--license.txt ├── info.rkt ├── LICENSE ├── identifiers.rkt ├── README.md ├── .travis.yml ├── contracts-to-types.rkt ├── parameterize-lexical-context.rkt ├── more-expanders.hl.rkt └── type-expander.hl.rkt /.gitmodules: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#* 3 | .\#* 4 | .DS_Store 5 | compiled 6 | /doc/ -------------------------------------------------------------------------------- /lang/reader.rkt: -------------------------------------------------------------------------------- 1 | (module reader syntax/module-reader 2 | type-expander/lang) -------------------------------------------------------------------------------- /base/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | (module reader syntax/module-reader 2 | type-expander/base) -------------------------------------------------------------------------------- /lang.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "lang/main.rkt") 3 | (provide (all-from-out "lang/main.rkt")) -------------------------------------------------------------------------------- /lang/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "../reader.rkt") 3 | (provide (all-from-out "../reader.rkt")) -------------------------------------------------------------------------------- /test/lang-test-1.rkt: -------------------------------------------------------------------------------- 1 | #lang type-expander 2 | (require typed/rackunit) 3 | (check-equal? (ann (add1 1) 4 | (Let ([T Number]) T)) 5 | 2) -------------------------------------------------------------------------------- /test/lang-test-3.rkt: -------------------------------------------------------------------------------- 1 | #lang type-expander/lang 2 | (require typed/rackunit) 3 | (check-equal? (ann (add1 1) 4 | (Let ([T Number]) T)) 5 | 2) -------------------------------------------------------------------------------- /test/base-lang-test-1.rkt: -------------------------------------------------------------------------------- 1 | #lang type-expander/base 2 | (require typed/rackunit) 3 | (check-equal? (ann (add1 1) 4 | (Let ([T Number]) T)) 5 | 2) -------------------------------------------------------------------------------- /test/base-lang-test-3.rkt: -------------------------------------------------------------------------------- 1 | #lang type-expander/base 2 | (require typed/rackunit) 3 | (check-equal? (ann (add1 1) 4 | (Let ([T Number]) T)) 5 | 2) -------------------------------------------------------------------------------- /test/lang-test-2.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (module m type-expander/lang 4 | (require typed/rackunit) 5 | (check-equal? (ann (add1 1) 6 | (Let ([T Number]) T)) 7 | 2)) -------------------------------------------------------------------------------- /test/base-lang-test-2.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (module m type-expander/base 4 | (require typed/rackunit) 5 | (check-equal? (ann (add1 1) 6 | (Let ([T Number]) T)) 7 | 2)) -------------------------------------------------------------------------------- /dbg.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | (require type-expander 3 | (for-syntax racket/list) 4 | (for-syntax type-expander/expander 5 | typed/rackunit 6 | debug-scopes)) 7 | 8 | (debug-type-expander #t) 9 | -------------------------------------------------------------------------------- /main.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | (require "type-expander.hl.rkt" 3 | "more-expanders.hl.rkt" 4 | (for-syntax "expander.rkt")) 5 | (provide (all-from-out "type-expander.hl.rkt") 6 | (all-from-out "more-expanders.hl.rkt") 7 | (for-syntax colon)) -------------------------------------------------------------------------------- /lang/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/require 4 | (subtract-in typed/racket type-expander) 5 | type-expander) 6 | 7 | (provide (all-from-out typed/racket 8 | type-expander)) 9 | 10 | (module reader syntax/module-reader 11 | type-expander/lang/main) -------------------------------------------------------------------------------- /base.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/require 4 | (subtract-in typed/racket/base type-expander) 5 | type-expander) 6 | 7 | (provide (all-from-out typed/racket/base 8 | type-expander)) 9 | 10 | (module reader syntax/module-reader 11 | type-expander/lang/main) -------------------------------------------------------------------------------- /expander.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require (submod "type-expander.hl.rkt" expander) 3 | (for-template (submod "type-expander.hl.rkt" main)) 4 | syntax/parse) 5 | (provide prop:type-expander 6 | expand-type 7 | apply-type-expander 8 | type 9 | stx-type/c 10 | type-expand! 11 | colon) 12 | -------------------------------------------------------------------------------- /utils.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (for-syntax syntax/parse)) 4 | 5 | (provide define-syntax/parse) 6 | 7 | ;; Copied from phc-toolkit, but does not bind "stx". Use this-syntax 8 | ;; instead, from syntax/parse. 9 | (define-syntax-rule (define-syntax/parse (name . args) body0 . body) 10 | (define-syntax (name stx2) 11 | ;(with-backtrace (syntax->datum stx2) 12 | (syntax-parse stx2 13 | [(_ . args) body0 . body]))) -------------------------------------------------------------------------------- /scribblings/type-expander-implementation.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{Type expander: Implementation} 4 | @author[@author+email["Suzanne Soy" "racket@suzanne.soy"]] 5 | 6 | This library is implemented using literate programming. The implementation 7 | details are presented in the following sections. The user documentation is in 8 | the @other-doc['(lib "type-expander/scribblings/type-expander.scrbl")] document. 9 | 10 | @(table-of-contents) 11 | @include-section[(submod "../type-expander.hl.rkt" doc)] 12 | @include-section[(submod "../more-expanders.hl.rkt" doc)] 13 | -------------------------------------------------------------------------------- /test/readme.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | (require type-expander 3 | typed/rackunit 4 | (for-syntax racket/list)) 5 | 6 | (define-type-expander (Repeat stx) 7 | (syntax-case stx () 8 | [(_ t n) 9 | #`(List #,@(map (λ (x) #'t) 10 | (range (syntax->datum #'n))))])) 11 | 12 | (: five-strings (→ String (Repeat String 5))) 13 | (define (five-strings x) 14 | (list x "a" "b" "c" "d")) 15 | 16 | (check-equal? (five-strings "hello") 17 | '("hello" "a" "b" "c" "d")) 18 | 19 | (check-equal? (ann (five-strings "moon") (Repeat String 5)) 20 | '("moon" "a" "b" "c" "d")) 21 | -------------------------------------------------------------------------------- /scribblings/deprecated-colon.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @require[@for-label[type-expander]] 4 | 5 | @(module m racket/base 6 | (require scribble/manual) 7 | (provide e:colon) 8 | (require (for-label type-expander/expander)) 9 | (define e:colon (racket colon))) 10 | @(require 'm) 11 | 12 | @title{Deprecated export of @racket[colon] via @racketmodname[type-expander]} 13 | 14 | @declare-exporting[type-expander] 15 | 16 | @defidform[colon]{ 17 | @deprecated[ 18 | #:what "reprovide" 19 | @list{@e:colon from @racketmodname[type-expander/expander]} 20 | @list{The @e:colon identifier is re-exported for-syntax as @racket[colon] by 21 | @racketmodname[type-expander]. Prefer instead explicitly using 22 | @racket[(require (for-syntax #,(racketmodname type-expander/expander)))], as 23 | the re-export will be removed in future versions.}]} -------------------------------------------------------------------------------- /licenses/bsd.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2000-2015 Dipanwita Sarkar, Andrew W. Keep, R. Kent Dybvig, Oscar Waddell 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a 4 | copy of this software and associated documentation files (the "Software"), 5 | to deal in the Software without restriction, including without limitation 6 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 7 | and/or sell copies of the Software, and to permit persons to whom the 8 | Software is furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 16 | THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 18 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 19 | DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define collection "type-expander") 3 | (define deps '("base" 4 | "rackunit-lib" 5 | "scribble-lib" 6 | "typed-racket-lib" 7 | "typed-racket-more" 8 | "hyper-literate" 9 | "auto-syntax-e" 10 | "debug-scopes" 11 | "version-case")) 12 | (define build-deps '("scribble-lib" 13 | "racket-doc" 14 | "typed-racket-more" 15 | "typed-racket-doc" 16 | "scribble-enhanced" 17 | ;; Just for a link to the library inside the documentation. 18 | ;; Can be removed and change the link 19 | ;; in type-expander.hl.rkt to 20 | ;; http://docs.racket-lang.org/mutable-match-lambda/ 21 | "mutable-match-lambda")) 22 | (define scribblings '(("scribblings/type-expander.scrbl" () ("typed-racket")) 23 | ("scribblings/type-expander-implementation.scrbl" (multi-page) ("typed-racket")))) 24 | (define pkg-desc "Description Here") 25 | (define version "1.0") 26 | (define pkg-authors '(|Suzanne Soy|)) 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This software was initially written as part of a project at Cortus, S.A.S. which 2 | can be reached at 97 Rue de Freyr, 34000 Montpellier, France. 3 | 4 | This software may contain a few pieces of code copied from typed/racket 5 | https://github.com/racket/typed-racket (mostly the syntax-parse syntax classes 6 | for the various overloaded forms) and is therefore licensed under the 7 | GNU Lesser General Public License (LGPL). 8 | 9 | 10 | This package is distributed under the GNU Lesser General Public 11 | License (LGPL). This means that you can link this package into proprietary 12 | applications, provided you follow the rules stated in the LGPL. You 13 | can also modify this package; if you distribute a modified version, 14 | you must distribute it under the terms of the LGPL, which in 15 | particular means that you must release the source code for the 16 | modified software. See http://www.gnu.org/copyleft/lesser.html 17 | for more information. 18 | 19 | under the BSD license, at your option. Both licenses can be found in the 20 | `licenses/` folder. 21 | 22 | This double-licensing has been chosen in order to make it possible to integrate 23 | the type-expander library with Typed/Racket 24 | (https://github.com/racket/typed-racket) and/or Racket 25 | (https://github.com/racket/racket), which are both under the LGPL license, as 26 | well as integrate the graph library with the Nanopass Compiler Framework 27 | (https://github.com/akeep/nanopass-framework), which is under the BSD license. -------------------------------------------------------------------------------- /identifiers.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require (for-syntax racket/syntax)) 4 | 5 | (define-syntax-rule (provide-id id) 6 | (begin 7 | (define-syntax (id stx) 8 | (raise-syntax-error 'id 9 | (format "Type expander form “~a” cannot be used as an expression" 10 | 'id) 11 | stx)) 12 | (provide id))) 13 | 14 | (define-syntax-rule (provide-ids id ...) (begin (provide-id id) ...)) 15 | 16 | (provide-ids Let Letrec Λ ...* No-Expand) 17 | 18 | ;; Define a mutable implementation for new-:, circumvent the fact that 19 | ;; typed/racket wraps macros with a contract. 20 | ;; 21 | ;; Technique from: 22 | ;; 23 | ;; https://github.com/racket/typed-racket/issues/329#issuecomment-205060192 24 | 25 | (define-syntax (provide-mutable-id stx) 26 | (syntax-case stx () 27 | [(_ short-id) 28 | (with-syntax ([id (format-id #'short-id "new-~a" #'short-id)] 29 | [id-set-impl (format-id #'short-id 30 | "set-~a-impl!" 31 | #'short-id)]) 32 | #'(begin 33 | (provide id id-set-impl) 34 | 35 | (define-for-syntax (id-impl-orig stx) 36 | (raise-syntax-error ': 37 | (format "Implementation for ~a was not loaded!" 38 | 'short-id) 39 | stx)) 40 | 41 | (define-for-syntax id-impl (box id-impl-orig)) 42 | 43 | (define-syntax (id stx) 44 | ((unbox id-impl) stx)) 45 | 46 | (define-syntax-rule (id-set-impl impl) 47 | (begin-for-syntax 48 | (when (eq? (unbox id-impl) id-impl-orig) 49 | (set-box! id-impl impl))))))])) 50 | 51 | (define-syntax-rule (provide-mutable-ids id ...) 52 | (begin (provide-mutable-id id) ...)) 53 | 54 | (provide-mutable-ids : 55 | ;; The class-related IDs need to also work as types. 56 | ;field 57 | ;super-new 58 | ) -------------------------------------------------------------------------------- /scribblings/contracts-to-types.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @require[(for-label racket/contract/base) 4 | scribble/example] 5 | @title{Using contract syntax to specify types} 6 | 7 | @defmodule[type-expander/contracts-to-types] 8 | 9 | @defform*[{(contract→type contract) 10 | (contract->type contract)}]{ 11 | 12 | This is a simple type expander which translates common contracts to types. 13 | Note that it only supports a limited number of contract constructors. The 14 | following are supported: @racket[or/c], @racket[and/c] (the translation may 15 | produce a type too complex for Typed/Racket to understand properly, though), 16 | @racket[listof], @racket[list/c], @racket[*list/c], @racket[vectorof], 17 | @racket[vector/c], @racket[cons/c], @racket[number?], @racket[integer?], 18 | @racket[string?], @racket[symbol?], @racket[char?], @racket[boolean?], 19 | @racket[bytes?], @racket[void?], @racket[null?], @racket[empty?], 20 | @racket[list?], @racket[exact-nonnegative-integer?], 21 | @racket[exact-positive-integer?], @racket[syntax/c], @racket[parameter/c], 22 | @racket[promise/c], @racket[suggest/c], @racket[flat-rec-contract], some uses 23 | of @racket[->] and @racket[->*], @racket['quoted-datum], 24 | @racket[`quasiquoted-datum-with-unquoted-types]. Literal data (numbers, 25 | strings, characters, booleans, byte strings, regular expressions and byte 26 | regular expressions) are also interpreted as singleton types. 27 | 28 | Furthermore, using @racket[,_τ] anywhere outside of a quoted datum will leave 29 | the type @racket[_τ] unchaged, allowing the user to manually convert to types 30 | only the parts which cannot be converted automatically.} 31 | 32 | @defform*[{(:contract→type contract) 33 | (:contract->type contract)}]{ 34 | 35 | Prints a representation of the contract translated as a type. It is then 36 | possible to copy-paste that result into the code. 37 | 38 | @examples[ 39 | (require type-expander/lang 40 | racket/contract/base 41 | type-expander/contracts-to-types) 42 | (:contract→type (list/c 1 2 "str" (or/c integer? string?)))] 43 | } 44 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status,](https://img.shields.io/travis/jsmaniac/type-expander/main.svg)](https://travis-ci.org/jsmaniac/type-expander) 2 | [![Coverage Status,](https://img.shields.io/coveralls/jsmaniac/type-expander/main.svg)](https://coveralls.io/github/jsmaniac/type-expander) 3 | [![Build Stats,](https://img.shields.io/website-stats-stats%20unavailable-blue-red/http/jsmaniac.github.io/travis-stats/.svg?label=build)](http://jsmaniac.github.io/travis-stats/#jsmaniac/type-expander) 4 | [![Online Documentation,](https://img.shields.io/website-online-offline-blue-red/http/docs.racket-lang.org/type-expander/.svg?label=docs)](http://docs.racket-lang.org/type-expander/) 5 | [![Maintained as of 2018.](https://img.shields.io/maintenance/yes/2018.svg)](https://github.com/jsmaniac/type-expander/issues) 6 | 7 | Type-expander 8 | ============= 9 | 10 | This project is written for 11 | [Typed/Racket](https://docs.racket-lang.org/ts-guide/) using Literate 12 | Programming. See the “[Implementation of the type expander 13 | library](http://docs.racket-lang.org/type-expander/)” part of the [online 14 | documentation](http://docs.racket-lang.org/type-expander/) if you want to dig 15 | into the source. 16 | 17 | This library enhances typed/racket with type expanders, which are special 18 | macros that can appear where a type would normally be expected, and must 19 | expand to a type. Type expanders are to types what match expanders are to 20 | match patterns. It is based on Asumu Takikawa's [type 21 | expanders](https://github.com/racket/racket/compare/master...takikawa:tr-type-expander) 22 | (see also his [original pull request 23 | here](https://github.com/racket/racket/pull/604)). Asumu Takikawa's work 24 | attempted to integrate type expanders directly into Typed/Racket. This 25 | project instead implements type expanders as a library and works without any 26 | modification of the core Typed/Racket codebase. This shows the extensibility 27 | of Typed/Racket thanks to macros, and could serve as the basis for other 28 | projects which need to alter the manner in which Typed/Racket handles types. 29 | 30 | Installation 31 | ============ 32 | 33 | ``` 34 | raco pkg install --deps search-auto type-expander 35 | ``` 36 | 37 | Usage example 38 | ============= 39 | 40 | The `type-expander` is enabled by simply requiring the `type-expander` module 41 | in a `typed/racket` program. 42 | 43 | #lang typed/racket 44 | (require type-expander) 45 | 46 | For example, one can write the `(HomogeneousList n t)` type-expander, which 47 | expands to the type for a list of `n` elements of type `t`: 48 | 49 | (require (for-syntax syntax/parse racket/list)) 50 | (define-type-expander (HomogeneousList stx) 51 | (syntax-parse stx 52 | [(_ t:expr n:nat) 53 | #`(List #,@(map (λ (x) #'t) 54 | (range (syntax-e #'n))))])) 55 | 56 | It can then be used wherever a regular type is usually expected: 57 | 58 | (: five-strings (→ String (HomogeneousList String 5))) 59 | (define (five-strings x) 60 | (list x "a" "b" "c" "d")) 61 | 62 | (five-strings "hello") 63 | ;; => '("hello" "a" "b" "c" "d") 64 | 65 | (ann (five-strings "moon") (HomogeneousList String 5)) 66 | ;; => '("moon" "a" "b" "c" "d") 67 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | 3 | # Based from: https://github.com/greghendershott/travis-racket 4 | 5 | # Optional: Remove to use Travis CI's older infrastructure. 6 | sudo: false 7 | 8 | env: 9 | global: 10 | # Supply a global RACKET_DIR environment variable. This is where 11 | # Racket will be installed. A good idea is to use ~/racket because 12 | # that doesn't require sudo to install and is therefore compatible 13 | # with Travis CI's newer container infrastructure. 14 | - RACKET_DIR=~/racket 15 | matrix: 16 | # Supply at least one RACKET_VERSION environment variable. This is 17 | # used by the install-racket.sh script (run at before_install, 18 | # below) to select the version of Racket to download and install. 19 | # 20 | # Supply more than one RACKET_VERSION (as in the example below) to 21 | # create a Travis-CI build matrix to test against multiple Racket 22 | # versions. 23 | #- RACKET_VERSION=6.0 24 | #- RACKET_VERSION=6.1 25 | #- RACKET_VERSION=6.1.1 26 | # Dependency "custom-load" does not work with 6.2 and 6.3 27 | #- RACKET_VERSION=6.2 28 | # Collection scribble/example is not available yet in 6.3 29 | #- RACKET_VERSION=6.3 30 | # Scribble bug in 6.4 which got fixed in 6.5 31 | #- RACKET_VERSION=6.4 32 | - RACKET_VERSION=6.5 33 | - RACKET_VERSION=6.6 34 | - RACKET_VERSION=6.7 35 | - RACKET_VERSION=6.8 36 | - RACKET_VERSION=6.9 37 | - RACKET_VERSION=6.10 38 | - RACKET_VERSION=6.10.1 39 | - RACKET_VERSION=6.11 40 | - RACKET_VERSION=6.12 41 | - RACKET_VERSION=7.0 42 | - RACKET_VERSION=7.1 43 | - RACKET_VERSION=7.2 44 | - RACKET_VERSION=HEAD 45 | 46 | matrix: 47 | allow_failures: 48 | # No support for https://github.com/user/repo.git#commit-hash in info.rkt "deps" 49 | - env: RACKET_VERSION=6.0 50 | - env: RACKET_VERSION=6.1 51 | - env: RACKET_VERSION=6.1.1 52 | - env: RACKET_VERSION=6.2 53 | - env: RACKET_VERSION=6.3 54 | fast_finish: true 55 | 56 | before_install: 57 | - git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket 58 | - cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh! 59 | - export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us 60 | 61 | install: 62 | - raco pkg install -j 1 --deps search-auto 63 | 64 | before_script: 65 | 66 | # Here supply steps such as raco make, raco test, etc. You can run 67 | # `raco pkg install --deps search-auto type-expander` to install any required 68 | # packages without it getting stuck on a confirmation prompt. 69 | script: 70 | - raco test -p type-expander 71 | - raco setup --check-pkg-deps --no-zo --no-launcher --no-install --no-post-install --no-docs --pkgs type-expander 72 | - raco pkg install --deps search-auto doc-coverage 73 | - if $RACKET_VERSION != "6.5" -a $RACKET_VERSION != "6.6"; then raco doc-coverage type-expander; fi 74 | 75 | after_success: 76 | - raco pkg install --deps search-auto cover cover-coveralls 77 | - raco pkg install --deps search-auto 78 | # TODO: raco cover doesn't support having a "-s " option, to run the entire module in addition to the specified submodules 79 | - raco cover -b -s doc -s test -s main -f coveralls -d $TRAVIS_BUILD_DIR/coverage . 80 | -------------------------------------------------------------------------------- /test/test-contracts-to-types.rkt: -------------------------------------------------------------------------------- 1 | #lang type-expander 2 | (require racket/contract/base 3 | type-expander/contracts-to-types 4 | typed/rackunit 5 | version-case) 6 | (define-syntax (if-version≥6.5 stx) 7 | (syntax-case stx () 8 | [(_ . rest) 9 | (if (version>= (version) "6.5") 10 | #'(begin . rest) 11 | #'(begin))])) 12 | 13 | (if-version≥6.5 14 | (define-syntax-rule (check-written=? a b) 15 | (check-equal? (with-output-to-string (λ () a)) (format "~s\n" b))) 16 | (check-written=? (:contract→type (list/c 1 2 "str" (or/c integer? string?))) 17 | '(List 1 2 "str" (U Integer String))) 18 | (check-written=? (:contract→type 19 | (list/c integer? string? boolean? char? bytes?)) 20 | '(List Integer String Boolean Char Bytes)) 21 | (check-written=? (:contract→type (*list/c integer? string? boolean?)) 22 | '(Rec R (U (Pairof Integer R) (List String Boolean)))) 23 | (check-written=? (:contract→type (-> integer? boolean? string? symbol?)) 24 | '(-> Integer Boolean String Symbol)) 25 | (check-written=? (:contract→type (-> integer? boolean? string? ... symbol?)) 26 | '(->* (Integer Boolean) #:rest String Symbol)) 27 | (check-written=? (:contract→type (->* (integer? boolean?) 28 | (char?) 29 | #:rest (listof string?) 30 | symbol?)) 31 | '(->* (Integer Boolean) (Char) #:rest String Symbol)) 32 | (check-written=? (:contract→type (->* (integer? boolean?) 33 | () 34 | #:rest (listof string?) 35 | symbol?)) 36 | '(->* (Integer Boolean) () #:rest String Symbol)) 37 | (check-written=? (:contract→type (->* (integer? boolean?) 38 | #:rest (listof string?) 39 | symbol?)) 40 | '(->* (Integer Boolean) #:rest String Symbol)) 41 | (check-written=? (:contract→type (->* (integer? boolean?) 42 | symbol?)) 43 | '(->* (Integer Boolean) Symbol)) 44 | (check-written=? (:contract→type (->* (integer? boolean?) 45 | (char?) 46 | symbol?)) 47 | '(->* (Integer Boolean) (Char) Symbol)) 48 | (check-written=? (:contract→type (->* (integer? boolean?) 49 | () 50 | symbol?)) 51 | '(->* (Integer Boolean) () Symbol)) 52 | (check-written=? (:contract→type 53 | (flat-rec-contract W (cons/c W W) number? string?)) 54 | '(Rec W (U (Pairof W W) Number String))) 55 | (check-written=? (:contract→type 56 | (flat-rec-contract W 57 | (cons/c (flat-rec-contract R 58 | (cons/c W R) 59 | null?) 60 | W) 61 | number? 62 | string?)) 63 | '(Rec W (U (Pairof (Rec R (U (Pairof W R) Null)) W) 64 | Number 65 | String)))) -------------------------------------------------------------------------------- /contracts-to-types.rkt: -------------------------------------------------------------------------------- 1 | #lang type-expander 2 | 3 | (provide :contract→type 4 | (rename-out [c→t contract→type] 5 | [c→t contract->type] 6 | [:contract→type :contract->type])) 7 | (require (prefix-in c: (combine-in racket/base racket/contract/base)) 8 | (for-syntax racket/base 9 | syntax/parse 10 | syntax/parse/experimental/template 11 | type-expander/expander)) 12 | 13 | (begin-for-syntax 14 | (define-syntax-class arrow 15 | (pattern {~or {~literal ->} {~literal →} {~literal c:->}})) 16 | (define-syntax-class arrow* 17 | (pattern {~or {~literal ->*} {~literal c:->*}}))) 18 | 19 | (define-type-expander c→t 20 | (syntax-parser 21 | [(_ ({~literal c:or/c} alt ...)) #'(U (c→t alt) ...)] 22 | [(_ ({~literal c:and/c} alt ...)) #'(∩ (c→t alt) ...)] 23 | [(_ ({~literal c:listof} c)) #'(Listof (c→t c))] 24 | [(_ ({~literal c:list/c} c ...)) #'(List (c→t c) ...)] 25 | [(_ ({~literal c:*list/c} prefix suffix ...)) 26 | #'(Rec R (U (Pairof (c→t prefix) R) 27 | (List (c→t suffix) ...)))] 28 | [(_ ({~literal c:vectorof} c)) #'(Vectorof (c→t c))] 29 | [(_ ({~literal c:vector/c} c ...)) #'(Vector (c→t c) ...)] 30 | [(_ ({~literal c:cons/c} a d)) #'(Pairof (c→t a) (c→t d))] 31 | [(_ {~literal c:number?}) #'Number] 32 | [(_ {~literal c:integer?}) #'Integer] 33 | [(_ {~literal c:string?}) #'String] 34 | [(_ {~literal c:symbol?}) #'Symbol] 35 | [(_ {~literal c:char?}) #'Char] 36 | [(_ {~literal c:boolean?}) #'Boolean] 37 | [(_ {~literal c:bytes?}) #'Bytes] 38 | [(_ {~literal c:void?}) #'Void] 39 | [(_ {~literal c:null?}) #'Null] 40 | [(_ {~literal c:empty?}) #'Null] 41 | [(_ {~literal c:list?}) #'(Listof Any)] 42 | [(_ {~literal c:exact-nonnegative-integer?}) #'Exact-Nonnegative-Integer] 43 | [(_ {~literal c:exact-positive-integer?}) #'Exact-Positive-Integer] 44 | [(_ ({~literal c:syntax/c} τ)) #'(Syntaxof (c→t τ))] 45 | [(_ ({~literal c:parameter/c} in)) #'(Parameterof (c→t in))] 46 | [(_ ({~literal c:parameter/c} in out)) #'(Parameterof (c→t in) (c→t out))] 47 | [(_ ({~literal c:promise/c} τ)) #'(Promise (c→t τ))] 48 | [(_ ({~literal c:suggest/c} τ)) #'(c→t τ)] 49 | [(_ ({~literal c:flat-rec-contract} R alt ...)) 50 | #`(Rec R (U (c→t alt) ...))] 51 | [(_ (a:arrow {~seq {~optional kw:keyword} 52 | {~and arg {~not {~literal ...}}}} 53 | ... 54 | rest {~and {~literal ...} ooo} 55 | result)) 56 | #:with rest-kw (datum->syntax #'here '#:rest #'ooo) 57 | #:with a* (datum->syntax #'here '->* #'a) 58 | (template (a* ((?@ (?? kw) (c→t arg)) ...) 59 | rest-kw (c→t rest) 60 | (c→t result)))] 61 | [(_ (a:arrow {~seq {~optional kw:keyword} 62 | {~and arg {~not {~literal ...}}}} 63 | ... 64 | result)) 65 | (template (a (?@ (?? kw) (c→t arg)) ... (c→t result)))] 66 | [(_ (a*:arrow* ({~seq {~optional mandatory-kw:keyword} 67 | mandatory-arg} 68 | ...) 69 | {~optional 70 | {~and opt 71 | ({~seq {~optional optional-kw:keyword} 72 | optional-arg} 73 | ...)}} 74 | {~optional {~seq #:rest ({~literal c:listof} rest)}} 75 | result)) 76 | (quasitemplate (a* ((?@ (?? mandatory-kw) (c→t mandatory-arg)) ...) 77 | #,@(if (attribute opt) 78 | (template 79 | {((?@ (?? optional-kw) (c→t optional-arg)) 80 | ...)}) 81 | #'{}) 82 | (?? (?@ #:rest (c→t rest))) 83 | (c→t result)))] 84 | [(_ {~literal c:any}) #'AnyValues] 85 | [(_ ({~literal c:values} v ...)) #'(Values (c→t v) ...)] 86 | [(_ {~and τ ({~literal quote} _)}) #'τ] 87 | [(_ {~and τ {~or :number :str :char :boolean}}) #''τ] 88 | [(_ {~and τ}) #:when (bytes? (syntax-e #'τ)) #''τ] 89 | [(_ {~and τ}) #:when (regexp? (syntax-e #'τ)) #''τ] 90 | [(_ {~and τ}) #:when (byte-regexp? (syntax-e #'τ)) #''τ] 91 | [(_ {~and τ ({~literal quasiquote} _)}) #'τ] 92 | [(_ ({~literal unquote} τ)) #'τ] 93 | [(_ v:id) 94 | ;; TODO: this is a terrible implementation. type-expander should provide 95 | ;; a way to attach information to an identifier, so that we can know that 96 | ;; v is a variable bound by flat-rec-contract. 97 | #'v] 98 | [(_ c) (raise-syntax-error 99 | 'contract→type 100 | (string-append 101 | "I cannot convert this contract to a type automatically." 102 | " Please fill in an issue at" 103 | " https://github.com/jsmaniac/type-expander/issues if the" 104 | " translation can easily be done automatically, or do the" 105 | " translation manually otherwise. ") 106 | #'c)])) 107 | 108 | (define-syntax (:contract→type stx) 109 | (syntax-case stx () 110 | [(_ c) #`(writeln '#,(expand-type #`(c→t c)))])) -------------------------------------------------------------------------------- /parameterize-lexical-context.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require (for-template racket/base) 4 | syntax/parse 5 | syntax/id-table 6 | (for-syntax syntax/parse 7 | racket/syntax 8 | syntax/parse/experimental/template) 9 | debug-scopes) 10 | 11 | (provide with-bindings 12 | with-rec-bindings 13 | tl-redirections 14 | start-tl-redirections 15 | f-start-tl-redirections 16 | binding-table-find-best 17 | binding-table-set! 18 | make-binding-table) 19 | 20 | (struct binding-table-struct (val)) 21 | 22 | (define/contract tl-redirections 23 | (parameter/c (or/c binding-table-struct? #f)) 24 | (make-parameter #f)) 25 | 26 | (define (make-binding-table) 27 | (-> binding-table-struct?) 28 | (binding-table-struct (make-hasheq))) 29 | 30 | (define/contract (binding-table-set! table id value) 31 | (-> binding-table-struct? identifier? any/c void?) 32 | (let ([group (hash-ref! (binding-table-struct-val table) 33 | (syntax-e id) 34 | (make-bound-id-table))]) 35 | (when (dict-has-key? group id) 36 | (raise-syntax-error 37 | 'type-expander 38 | "Attempted to re-bind the same identifier with the same scopes" 39 | id)) 40 | (bound-id-table-set! group id value))) 41 | 42 | (define (binding-table-find-best table id fallback) 43 | (-> binding-table-struct? identifier? (or/c procedure? any/c) void?) 44 | (define (scopes-of i) 45 | (list->set (map (λ (v) (vector-ref v 0)) 46 | (hash-ref (syntax-debug-info i) 'context)))) 47 | (define scopes-of-id (scopes-of id)) 48 | (let* ([group (hash-ref (binding-table-struct-val table) 49 | (syntax-e id) 50 | (λ () (make-bound-id-table)))] 51 | [candidates (filter (λ (other) 52 | (subset? (car other) scopes-of-id)) 53 | (bound-id-table-map group 54 | (λ (a b) 55 | (list (scopes-of a) a b))))]) 56 | (if (= 0 (length candidates)) 57 | (if (procedure? fallback) 58 | (fallback) 59 | fallback) 60 | (let* ([best-candidate (argmax (λ (c) (set-count (car c))) 61 | candidates)]) 62 | (for ([c candidates]) 63 | (unless (subset? (car c) (car best-candidate)) 64 | (raise-syntax-error 'type-expander 65 | (format "Ambiguous bindings: ~a" 66 | (map (λ (c) (list (cadr c) (car c))) 67 | candidates))))) 68 | (caddr best-candidate))))) 69 | 70 | (define-syntax-rule (start-tl-redirections . rest) 71 | (parameterize ([tl-redirections (or (tl-redirections) 72 | (make-binding-table))]) 73 | . rest)) 74 | 75 | (define-syntax-rule (f-start-tl-redirections f) 76 | (λ l (start-tl-redirections (apply f l)))) 77 | 78 | 79 | (define-syntax with-bindings 80 | (syntax-parser 81 | [(_ [{~or v1:id (v* {~and ooo {~literal ...}})} e/es] x code ...+) 82 | #:with vs (if (attribute ooo) #'(v* ooo) #'(v1)) 83 | #:with es (if (attribute ooo) #'e/es #'(list e/es)) 84 | (template 85 | (let () 86 | (define ctx (make-syntax-introducer)) 87 | (invariant-assertion (λ (ll) (and (list? ll) 88 | (andmap identifier? ll))) 89 | (syntax->list #'vs)) 90 | (for ([binding (in-syntax #'vs)] 91 | [value es]) 92 | (binding-table-set! (tl-redirections) (ctx binding) value)) 93 | (with-syntax ([(vs x) 94 | (ctx #'(vs x))]) 95 | code ...)))])) 96 | 97 | (define-syntax with-rec-bindings 98 | (syntax-parser 99 | [(_ [{~or v1:id (v* {~and ooo {~literal ...}})} func e/es] x code ...+) 100 | #:with vs (if (attribute ooo) #'(v* ooo) #'(v1)) 101 | #:with es (if (attribute ooo) #'(e/es ooo) #'(e/es)) 102 | (template 103 | (let () 104 | (define ctx (make-syntax-introducer)) 105 | (define ctx2 (make-syntax-introducer #t)) 106 | (invariant-assertion (λ (ll) (and (list? ll) 107 | (andmap identifier? ll))) 108 | (syntax->list #'vs)) 109 | (for ([binding (in-syntax #'vs)] 110 | [stx-value (in-syntax #'es)]) 111 | (let ([vvv (func (ctx stx-value))]) 112 | (binding-table-set! (tl-redirections) 113 | (ctx binding) 114 | vvv))) 115 | (with-syntax ([(vs x) 116 | (ctx2 (ctx #'(vs x)))]) 117 | code ...)))])) 118 | 119 | (provide trampoline-eval) 120 | (define trampoline-result (make-parameter #f)) 121 | (define (trampoline-eval code) 122 | (define result 'not-yet-result) 123 | (parameterize ([trampoline-result (λ (v) (set! result v))]) 124 | (local-expand (syntax-local-introduce 125 | #`(let-syntax ([tr ((trampoline-result) #,code)]) 126 | (void))) 127 | 'expression 128 | '())) 129 | result) 130 | 131 | 132 | (module+ test 133 | (require rackunit) 134 | (check-equal? (let () 135 | (define tbl (make-binding-table)) 136 | (define id #'id) 137 | (binding-table-set! tbl id 123) 138 | (define ctx (make-syntax-introducer)) 139 | (binding-table-set! tbl (ctx id) 456) 140 | (define ctx2 (make-syntax-introducer)) 141 | (list (binding-table-find-best tbl id #f) 142 | (binding-table-find-best tbl (ctx id) #f) 143 | (binding-table-find-best tbl (ctx2 id) #f) 144 | (binding-table-find-best tbl (ctx2 (ctx id)) #f) 145 | (binding-table-find-best tbl (ctx (ctx2 id)) #f))) 146 | '(123 456 123 456 456))) -------------------------------------------------------------------------------- /licenses/lgpl-3.0--license.txt: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /more-expanders.hl.rkt: -------------------------------------------------------------------------------- 1 | #lang hyper-literate typed/racket/base #:no-require-lang #:no-auto-require 2 | @; The #:no-require-lang above is needed because type-expander requires 3 | @; from 'main some identifiers (e.g. λ) which conflict with the re-required 4 | @; racket/base. With this option, we loose arrows in DrRacket for the 5 | @; built-ins in this file, and have otherwise no adverse effects. 6 | @(require scribble-enhanced/doc) 7 | @doc-lib-setup 8 | 9 | @(module orig-ids racket/base 10 | (require scribble/manual 11 | (for-label typed/racket/base)) 12 | (provide (all-defined-out)) 13 | (define orig:: (racket :)) 14 | (define orig:let (racket let)) 15 | (define orig:→AnyBoolean:Integer (racket (→ Any Boolean : Integer)))) 16 | @(require 'orig-ids) 17 | 18 | @(unless-preexpanding 19 | (require racket/require 20 | (for-label "type-expander.hl.rkt" 21 | (submod "type-expander.hl.rkt" expander) 22 | (subtract-in typed/racket/base 23 | "type-expander.hl.rkt") 24 | (subtract-in racket 25 | typed/racket/base 26 | "type-expander.hl.rkt") 27 | typed/racket/unsafe 28 | racket/format 29 | racket/syntax 30 | syntax/stx 31 | syntax/parse 32 | syntax/parse/experimental/template 33 | syntax/id-table))) 34 | 35 | @title[#:style manual-doc-style 36 | #:tag "ty-xp-more" 37 | #:tag-prefix "type-expander/ty-xp-more"]{Some example type expanders} 38 | 39 | @(chunks-toc-prefix 40 | '("(lib type-expander/scribblings/type-expander-implementation.scrbl)" 41 | "type-expander/ty-xp-more")) 42 | 43 | @section{Example type expanders: quasiquote and quasisyntax} 44 | 45 | We define type expanders for @racket[quote], @racket[quasiquote], 46 | @racket[syntax] and @racket[quasisyntax]: 47 | 48 | The next four special forms are implemented as type expanders with 49 | @tc[patch-type-expander] because redefining their name (@tc[quote], 50 | @tc[quasiquote], @tc[syntax] and @tc[quasisyntax]) would conflict with 51 | existing identifiers. @racket[patch-type-expander] uses a global persistant 52 | (across modules) for-syntax mutable table, which associates identifiers to 53 | type-expanders. @note{ @racketmodname[typed/racket] works in that way by 54 | associating data (their type) to existing identifiers. The 55 | @racketmodname[mutable-match-lambda] library on the other hand allows adding 56 | behaviour to an identifier after it is defined, but relies on some level of 57 | cooperation from that identifier, which may be less practical for built-in 58 | identifiers like @racket[quote].} Relying on an external data structure to 59 | associate information with identifiers makes it possible to overload the 60 | meaning of @tc[quote] or @tc[curry] when used as a type expander, without 61 | having to alter their original definition. Another option would be to provide 62 | overloaded versions of these identifiers, to shadow those imported by the 63 | @litchar{#lang} module. This would however cause conflicts for @tc[curry] when 64 | @tc[racket/function] is explicitly required (instead of being required 65 | implicitly by @racket[#,hash-lang #,(racketmodname racket)], for example. 66 | 67 | @chunk[ 68 | (patch-type-expander quote 69 | (λ (stx) 70 | (syntax-case stx () 71 | [(_ T) 72 | (expand-quasiquote 'quote 1 #'T)])))] 73 | 74 | @chunk[ 75 | (patch-type-expander quasiquote 76 | (λ (stx) 77 | (syntax-case stx () 78 | [(_ T) 79 | (expand-quasiquote 'quasiquote 1 #'T)])))] 80 | 81 | @chunk[ 82 | (patch-type-expander syntax 83 | (λ (stx) 84 | (syntax-case stx () 85 | [(_ T) 86 | (expand-quasiquote 'syntax 1 #'T)])))] 87 | 88 | @chunk[ 89 | (patch-type-expander quasisyntax 90 | (λ (stx) 91 | (syntax-case stx () 92 | [(_ T) 93 | (expand-quasiquote 'quasisyntax 1 #'T)])))] 94 | 95 | Their implementation is factored out into the @tc[expand-quasiquote] 96 | for-syntax function. It is a reasonably complex showcase of this library's 97 | functionality. @racketmodname[typed/racket] allows the use of @tc[quote] to 98 | describe a type which contains a single inhabitant, the quoted datum. For 99 | example, @tc[(define-type foo '(a b (1 2 3) c))] declares a type @tc[foo] 100 | which is equivalent to @tc[(List 'a 'b (List 1 2 3) 'c)]. 101 | 102 | We build upon that idea to allow the use of @tc[syntax], 103 | @tc[quasiquote] and @tc[quasisyntax]. Both @tc[syntax] and 104 | @tc[quasisyntax] wrap each s-expression within the quoted 105 | datum with @tc[Syntaxof], which avoids the otherwise tedious 106 | declaration of the type for a piece of syntax. Both 107 | @tc[quasiquote] and @tc[quasisyntax] allow escaping the 108 | quoted datum (using @tc[unquote] and @tc[unsyntax], 109 | respectively). A later version of this library could 110 | support @tc[unquote-splicing] and @tc[unsyntax-splicing]. 111 | 112 | Using this type-expander, one can write 113 | @racketblock[(define-type bar `(a ,Symbol (1 ,(U Number String) 3) c))] 114 | The above declaration gets expanded to: 115 | @racketblock[(define-type bar (List 'a Symbol (List 1 (U Number String) 3) 'c))] 116 | 117 | The implementation of @tc[expand-quasiquote] recursively 118 | traverses the type expression. The @tc[mode] argument 119 | can be one of @tc['quote], @tc['quasiquote], @tc['syntax] or 120 | @tc['quasisyntax]. It is used to determine whether to wrap 121 | parts of the type with @tc[Syntaxof] or not, and to know 122 | which identifier escapes the quoting (@tc[unquote] or 123 | @tc[unsyntax]). The @tc[depth] argument keeps track of the 124 | quoting depth: in Racket @tc[`(foo `(bar ,baz))] is 125 | equivalent to 126 | @tc[(list 'foo (list 'quasiquote (list 'bar (list 'unquote 'baz))))] 127 | (two levels of @tc[unquote] are required to escape the two 128 | levels of @tc[quasiquote]), so we want the type to be 129 | @tc[(List 'foo (List 'quasiquote (List 'bar (List 'unquote 'baz))))]. 130 | 131 | @CHUNK[ 132 | (define (list*->list l) 133 | (if (pair? l) 134 | (cons (car l) (list*->list (cdr l))) 135 | (list l))) 136 | (define (expand-quasiquote mode depth stx) 137 | (define (wrap t) 138 | (if (or (eq? mode 'syntax) (eq? mode 'quasisyntax)) 139 | #`(Syntaxof #,t) 140 | t)) 141 | (define (wrap-quote t) 142 | (if (or (eq? mode 'syntax) (eq? mode 'quasisyntax)) 143 | #`(Syntaxof (No-Expand (quote #,t))) 144 | #`(No-Expand (quote #,t)))) 145 | (define expand-quasiquote-rec (curry expand-quasiquote mode depth)) 146 | (syntax-parse stx 147 | [((~literal quote) T) 148 | (wrap #`(List #,(wrap-quote #'quote) 149 | #,(expand-quasiquote-rec #'T)))] 150 | [((~literal quasiquote) T) 151 | (wrap #`(List #,(wrap-quote #'quasiquote) 152 | #,(if (eq? mode 'quasiquote) 153 | (expand-quasiquote mode (+ depth 1) #'T) 154 | (expand-quasiquote-rec #'T))))] 155 | [((~literal unquote) T) 156 | (if (eq? mode 'quasiquote) 157 | (if (= depth 1) 158 | (expand-type #'T) ;; TODO: applicable? !!!!!!!!!!!!!!!!!!!!!!!!!!!! 159 | (wrap #`(List #,(wrap-quote #'unquote) 160 | #,(expand-quasiquote mode (- depth 1) #'T)))) 161 | (wrap #`(List #,(wrap-quote #'unquote) 162 | #,(expand-quasiquote-rec #'T))))] 163 | [((~literal syntax) T) 164 | (wrap #`(List #,(wrap-quote #'quote) 165 | #,(expand-quasiquote-rec #'T)))] 166 | [((~literal quasisyntax) T) 167 | (wrap #`(List #,(wrap-quote #'quasisyntax) 168 | #,(if (eq? mode 'quasisyntax) 169 | (expand-quasiquote mode (+ depth 1) #'T) 170 | (expand-quasiquote-rec #'T))))] 171 | [((~literal unsyntax) T) 172 | (if (eq? mode 'quasisyntax) 173 | (if (= depth 1) 174 | (expand-type #'T) ;; TODO: applicable? !!!!!!!!!!!!!!!!!!!!!!!!!!!! 175 | (wrap #`(List #,(wrap-quote #'unsyntax) 176 | #,(expand-quasiquote mode (- depth 1) #'T)))) 177 | (wrap #`(List #,(wrap-quote #'unsyntax) 178 | #,(expand-quasiquote-rec #'T))))] 179 | ;; TODO For lists, we should consider the cases where syntax-e gives 180 | ;; a pair vs the cases where it gives a list. 181 | [(T . U) 182 | #:when (syntax? (cdr (syntax-e stx))) 183 | (wrap #`(Pairof #,(expand-quasiquote-rec #'T) 184 | #,(expand-quasiquote-rec #'U)))] 185 | [() (wrap #'Null)] 186 | [(T ...) 187 | #:when (list? (syntax-e stx)) 188 | (wrap #`(List #,@(stx-map expand-quasiquote-rec #'(T ...))))] 189 | [whole 190 | #:when (pair? (syntax-e #'whole)) 191 | #:with (T ... S) (list*->list (syntax-e #'whole)) 192 | (wrap #`(List* #,@(stx-map expand-quasiquote-rec #'(T ... S))))] 193 | [#(T ...) 194 | (wrap #`(Vector #,@(stx-map expand-quasiquote-rec #'(T ...))))] 195 | [#&T (wrap #`(Boxof #,(expand-quasiquote-rec #'T)))] 196 | ; TODO: Prefab with #s(prefab-struct-key type ...) 197 | [T:id (wrap #'(No-Expand (quote T)))] 198 | [T #:when (string? (syntax-e #'T)) (wrap #'T)] 199 | [T:number (wrap #'T)] 200 | [T:keyword (wrap #'(No-Expand (quote T)))] 201 | [T:char (wrap #'T)] 202 | [#t (wrap #'True)] 203 | [#t (wrap #'False)] 204 | [_ (raise-syntax-error 'expand-quasiquoste 205 | (format "Unknown quasiquote contents: ~a" stx) 206 | stx)]))] 207 | 208 | @section{Implementation of the @racket[Let*] special type expander form} 209 | 210 | The @racket[Let*] special form is implemented in terms of @racket[Let], 211 | binding each variable in turn: 212 | 213 | @chunk[ 214 | (define-type-expander (Let* stx) 215 | (syntax-case stx () 216 | [(me ([var val] . rest) τ) 217 | (with-syntax ([L (datum->syntax #'here 'Let #'me #'me)] 218 | [L* (datum->syntax #'here 'Let* #'me #'me)]) 219 | #'(L ([var val]) 220 | (L* rest 221 | τ)))] 222 | [(_ () τ) #'τ]))] 223 | 224 | @section{curry} 225 | 226 | The @tc[curry] special form takes a type expander (or a polymorphic type) and 227 | some arguments. The whole form should appear in the first position of its 228 | containing form, which contains more arguments, or be bound with a 229 | @racket[Let] or @racket[Letrec]. @tc[curry] appends the arguments in the outer 230 | form to the whole inner form, and expands the result. This really should be 231 | implemented as a type expander so that the partially-applied expander or 232 | polymorphic type can be bound using @tc[Let], for example, but for now it is 233 | hardcoded here. 234 | 235 | @chunk[ 236 | (patch-type-expander curry 237 | (λ (stx) 238 | (syntax-case stx () 239 | [(_ T Arg1 ...) 240 | #'(Λ (_ . Args2) #'(T Arg1 ... . Args2))])))] 241 | 242 | @section{Putting it all together} 243 | 244 | @chunk[<*> 245 | (require "type-expander.hl.rkt" 246 | "identifiers.rkt" 247 | racket/function 248 | (for-syntax racket/base 249 | (only-in racket/base [... …]) 250 | (submod "type-expander.hl.rkt" expander) 251 | syntax/parse 252 | syntax/stx 253 | racket/function 254 | racket/match)) 255 | (provide Let*) 256 | 257 | 258 | 259 | (begin-for-syntax ) 260 | 261 | 262 | ] -------------------------------------------------------------------------------- /test/type-expander-test.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket 2 | 3 | (require type-expander 4 | typed/rackunit 5 | (for-syntax type-expander/expander 6 | racket/list 7 | version/utils 8 | rackunit 9 | syntax/parse)) 10 | 11 | ; Tests for expand-type 12 | (begin 13 | ;; Test harness: 14 | (begin 15 | (define-syntax (test-expander stx) 16 | (syntax-parse stx 17 | [(_ type expanded-type) 18 | (let ([actual (syntax->datum (expand-type #'type))] 19 | [expected (syntax->datum #'expanded-type)]) 20 | (unless (equal? actual expected) 21 | (raise-syntax-error 22 | 'test-expander 23 | (format "test-expander failed: expected ~a, got ~a" 24 | expected 25 | actual) 26 | stx 27 | #'type)) 28 | #`(check-equal? '#,actual 29 | '#,expected))]))) 30 | 31 | ; Simple identity expander test, with a different case when used as a 32 | ; simple identifier. 33 | 34 | (begin 35 | (define-type-expander (id stx) 36 | (syntax-case stx () 37 | [(_ t) #'t] 38 | [x #'(∀ (A) (→ A A))])) 39 | 40 | (test-expander (id Number) Number) 41 | (test-expander id (∀ (A) (→ A A)))) 42 | 43 | (begin 44 | (define-type-expander (double stx) 45 | (syntax-case stx () 46 | [(_ t) #'(id (Pairof (id t) t))])) 47 | 48 | (test-expander (∀ (A) (→ A (id (double (id A))))) 49 | (∀ (A) (→ A (Pairof A A)))) 50 | 51 | (test-expander (→ Any Boolean : (double (id A))) 52 | (→ Any Boolean : (Pairof A A)))) 53 | 54 | ;; Curry expander arguments: 55 | (begin 56 | (define-type-expander (CPairof stx) 57 | (syntax-case stx () 58 | [(_ a) #'(curry Pairof a)] 59 | [(_ a b) #'(Pairof a b)])) 60 | 61 | (test-expander (CPairof Number String) 62 | (Pairof Number String)) 63 | 64 | (test-expander ((CPairof Number) String) 65 | (Pairof Number String)) 66 | 67 | (check-equal? (ann (ann '(1 . "b") (CPairof Number String)) 68 | (Pairof Number String)) 69 | '(1 . "b")) 70 | 71 | (check-equal? (ann (ann '(1 . "c") ((CPairof Number) String)) 72 | (Pairof Number String)) 73 | '(1 . "c"))) 74 | 75 | ;; Shadowing with ∀ variables: 76 | (begin 77 | (test-expander (∀ (id) (→ id)) 78 | (∀ (id) (→ id))) 79 | (test-expander (∀ (id2) (→ id)) 80 | (∀ (id2) (→ (∀ (A) (→ A A)))))) 81 | 82 | (begin 83 | (define-type-expander (Repeat stx) 84 | (syntax-case stx () 85 | [(_ t n) #`(List #,@(map (λ (x) #'t) 86 | (range (syntax->datum #'n))))])) 87 | 88 | (test-expander (Repeat Number 5) 89 | (List Number Number Number Number Number))) 90 | 91 | (begin 92 | (: count-five-more (→ Number (Repeat Number 5))) 93 | (define (count-five-more x) 94 | (list (+ x 1) (+ x 2) (+ x 3) (+ x 4) (+ x 5))) 95 | 96 | (check-equal? (count-five-more 3) 97 | '(4 5 6 7 8)) 98 | (check-equal? (ann (count-five-more 15) (Repeat Number 5)) 99 | '(16 17 18 19 20))) 100 | 101 | ;; Shadowing with Rec variables: 102 | 103 | (begin 104 | (: repeat-shadow (→ Number (Rec Repeat (U Null (List Number Repeat))))) 105 | (define (repeat-shadow n) 106 | (if (= n 0) 107 | '() 108 | (list n (repeat-shadow (sub1 n))))) 109 | (check-equal? (repeat-shadow 5) 110 | '(5 (4 (3 (2 (1 ())))))) 111 | (test-expander (→ Number (Rec Repeat (U Null (List Number Repeat)))) 112 | (→ Number (Rec Repeat (U Null (List Number Repeat)))))) 113 | 114 | ;; Shadowing with Let: 115 | 116 | (begin 117 | (let () 118 | (define-type-expander (exp stx) 119 | #'(List 1 2 3)) 120 | 121 | (define-type e String) 122 | (: x (List e (Let ([e exp]) e))) 123 | (define x (list "e1" (list 1 2 3))) 124 | (check-equal? x '("e1" (1 2 3))) 125 | (test-expander (List e (Let ([e exp]) e)) 126 | (List e (List 1 2 3))) 127 | 128 | (: y (List e)) 129 | (define y (list "e2")) 130 | (check-equal? y '("e2")) 131 | (test-expander (List e) 132 | (List e)) 133 | (void))) 134 | 135 | ;; Let, Λ and ∀ 136 | (begin 137 | (let () 138 | (define-type-expander Str1 (λ (_) #'String)) 139 | 140 | (test-expander (Let ([Number Str1]) Number) 141 | String) 142 | (test-expander (Let ([Number (Λ stx #'String)]) (Number)) 143 | String) 144 | (test-expander (Let ([Number (Λ stx #'Str1)]) (Number)) 145 | String) 146 | (test-expander (Let ([Number (Λ stx #'String)]) Number) 147 | String) 148 | 149 | (test-expander ((∀ (A) (Pairof A A)) Number) 150 | (Pairof Number Number)) 151 | (test-expander (Let ([String (∀ (A) (Pairof A A))]) 152 | (String Number)) 153 | (Pairof Number Number)) 154 | 155 | (test-expander (Let ([Poly-Repeat 156 | (Λ (_ n) 157 | #`(∀ (A) 158 | (List #,@(map (λ (_) #'A) 159 | (range (syntax-e #'n))))))] 160 | [Number String]) 161 | ((Poly-Repeat 5) Number)) 162 | (List String String String String String)) 163 | 164 | (test-expander (Let ([Poly-Repeat 165 | (Λ (_ n) 166 | #`(∀ (A) 167 | (List #,@(map (λ (_) #'A) 168 | ;; like above, but also works 169 | ;; without the syntax-e here: 170 | (range n)))))] 171 | [Number String]) 172 | ((Poly-Repeat 5) Number)) 173 | (List String String String String String)) 174 | 175 | (ann '(1 . "b") ((Let ([Foo String]) 176 | (∀ (ty) 177 | (Pairof ty Foo))) 178 | Integer)) 179 | 180 | (test-expander ((∀ (A1) 181 | (Let () 182 | (Let () 183 | (Let () 184 | (Let () 185 | A1))))) 186 | Number) 187 | Number) 188 | 189 | (void))) 190 | 191 | ;; Let*, Letrec 192 | (let () 193 | (test-expander 194 | (Letrec ([Poly-Repeat 195 | (Λ (_ n) 196 | (if (= 0 n) 197 | #'(∀ (A) Null) 198 | #`(∀ (A) 199 | (Pairof A 200 | ((Poly-Repeat #,(sub1 n)) A)))))] 201 | [Number String]) 202 | ((Poly-Repeat 5) Number)) 203 | (Pairof String 204 | (Pairof String 205 | (Pairof String 206 | (Pairof String 207 | (Pairof String Null)))))) 208 | 209 | #;(test-expander (Let* ([String Number] 210 | [Number String]) 211 | (List Number String)) 212 | (List Number Number)) 213 | (void))) 214 | 215 | ;; Test ":" 216 | (begin 217 | (: c0 `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d)) 218 | (define c0 '(2 "abc" #,(x . z) #(1 "b" x) d)) 219 | 220 | (let () 221 | (define-type-expander (Repeat stx) 222 | (syntax-case stx () 223 | [(_ t n) #`(List #,@(map (λ (x) #'t) 224 | (range (syntax->datum #'n))))])) 225 | 226 | (: x (→ (Repeat Number 5))) 227 | (define (x) (list 1 2 3 4 5)) 228 | (check-equal? (x) '(1 2 3 4 5)))) 229 | 230 | ;; Test define-type 231 | (let () 232 | (define-type-expander (Repeat stx) 233 | (syntax-case stx () 234 | [(_ t n) #`(List #,@(map (λ (x) #'t) 235 | (range (syntax->datum #'n))))])) 236 | 237 | (define-type R5 (Repeat Number 5)) 238 | (check-equal? (ann '(1 2 3 4 5) R5) '(1 2 3 4 5))) 239 | 240 | ;; Test define 241 | (begin 242 | (define d0 243 | : `(2 "abc" #,,(Pairof (U 'x 'y) (U 'y 'z)) #(1 "b" x) d) 244 | '(2 "abc" #,(x . z) #(1 "b" x) d)) 245 | (check-equal? (ann d0 (List 2 246 | "abc" 247 | (List 'unsyntax 248 | (Pairof (U 'x 'y) (U 'y 'z))) 249 | (Vector 1 "b" 'x) 'd)) 250 | '(2 "abc" (unsyntax (x . z)) #(1 "b" x) d)) 251 | 252 | (: d1 (→ Number (→ Number Number))) 253 | (define ((d1 [x : Number]) [y : Number]) : Number (+ x y)) 254 | (check-equal? (ann ((d1 2) 3) Number) 5) 255 | 256 | (: d2 (→ Number (→ Number Number))) 257 | (define ((d2 [x : Number]) [y : Number]) (+ x y)) 258 | (check-equal? (ann ((d2 3) 4) Number) 7) 259 | 260 | (define #:∀ (T) ((d3 [x : T]) [y : T]) : (Pairof T T) (cons x y)) 261 | (check-equal? (ann ((d3 'x) 'y) (Pairof Symbol Symbol)) '(x . y))) 262 | 263 | ;; Test lambda 264 | (begin 265 | (check-equal? ((ann (lambda ([x : Number]) : Number (* x 2)) 266 | (→ Number Number)) 267 | 3) 268 | 6) 269 | (check-equal? ((ann (λ ([x : Number]) : Number (* x 2)) 270 | (→ Number Number)) 271 | 3) 272 | 6) 273 | (check-equal? ((λ x x) 1 2 3) '(1 2 3)) 274 | (check-equal? ((λ #:∀ (A) [x : A ...*] : (Listof A) x) 1 2 3) '(1 2 3)) 275 | (check-equal? ((λ [x : Number ...*] : (Listof Number) x) 1 2 3) '(1 2 3)) 276 | (check-not-exn (λ () 277 | (ann (λ #:∀ (A) [x : A ...*] : (Listof A) x) 278 | (∀ (A) (→ A * (Listof A)))))) 279 | (check-not-exn (λ () 280 | (ann (λ #:∀ (A) [x : A *] : (Listof A) x) 281 | (∀ (A) (→ A * (Listof A)))))) 282 | (check-not-exn (λ () 283 | (ann (λ #:∀ (A ...) ([l : (List A ... A)]) : (List A ... A) 284 | l) 285 | (∀ (A ...) (→ (List A ... A) (List A ... A)))))) 286 | (check-not-exn (λ () 287 | (ann (λ #:∀ (A ...) [l : (List A ... A) *] 288 | : (Listof (List A ... A)) 289 | l) 290 | (∀ (A ...) (→ (List A ... A) * 291 | (Listof (List A ... A))))))) 292 | (check-not-exn (λ () 293 | (ann (λ #:∀ (A ...) [l : (List A ... A) ...*] 294 | : (Listof (List A ... A)) 295 | l) 296 | (∀ (A ...) (→ (List A ... A) * 297 | (Listof (List A ... A)))))))) 298 | 299 | ;; Test struct 300 | (begin 301 | (struct s0 ()) 302 | (struct s1 ([x : Number])) 303 | (struct s2 ([x : Number] [y : Number])) 304 | (struct s3 ([x : Number] [y : Number]) #:transparent) 305 | (struct s4 () #:transparent) 306 | (struct (A B) s5 ([x : A] [y : B]) #:transparent) 307 | (struct (A B) s6 () #:transparent) 308 | (struct s7 s2 ([z : String]) #:transparent) 309 | (struct (A) s8 s3 ([z : A]) #:transparent) 310 | (struct (A B C) s9 s5 ([z : C]) #:transparent) 311 | (struct (A B C) s10 s2 ([z : C]) #:transparent) 312 | (struct (A B C) s11 s5 ([z : C])) 313 | 314 | (check (λ (a b) (not (equal? a b))) (s0) (s0)) 315 | (check-equal? (s1-x (s1 123)) 123) 316 | (check-equal? (s2-x (s2 2 3)) 2) 317 | (check-equal? (s2-y (s2 2 3)) 3) 318 | (check-equal? (s3-x (s3 4 5)) 4) 319 | (check-equal? (s3-y (s3 4 5)) 5) 320 | (check-equal? (s4) (s4)) 321 | (check-equal? (s5-x (s5 6 7)) 6) 322 | (check-equal? (s5-y (s5 6 7)) 7) 323 | (check-equal? (s5 6 7) (s5 6 7)) 324 | (check-equal? ((inst s5 Number String) 6 "g") (s5 6 "g")) 325 | (check-equal? (s6) (s6)) 326 | (check-equal? ((inst s6 Number String)) (s6)) 327 | 328 | ;(check-equal? (s7-x (s7 -1 -2 "c") -1)) 329 | ;(check-equal? (s7-y (s7 -1 -2 "c") -2)) 330 | (check-equal? (s7-z (s7 -1 -2 "c")) "c") 331 | (check-equal? (s2-x (s7 -1 -2 "c")) -1) 332 | (check-equal? (s2-y (s7 -1 -2 "c")) -2) 333 | (check-not-equal? (s7 -1 -2 "c") (s7 -1 -2 "c")) 334 | (check-not-exn (λ () (ann (s7 -1 -2 "c") s2))) 335 | (check-true (s2? (s7 -1 -2 "c"))) 336 | 337 | ;(check-equal? (s8-x (s8 -1 -2 "c") -1)) 338 | ;(check-equal? (s8-y (s8 -1 -2 "c") -2)) 339 | (check-equal? (s8-z (s8 -1 -2 "c")) "c") 340 | (check-equal? (s3-x (s8 -1 -2 "c")) -1) 341 | (check-equal? (s3-y (s8 -1 -2 "c")) -2) 342 | (check-equal? (s8 -1 -2 "c") (s8 -1 -2 "c")) 343 | (check-equal? ((inst s8 String) -1 -2 "c") (s8 -1 -2 "c")) 344 | (check-not-exn (λ () (ann ((inst s8 String) -1 -2 "c") s3))) 345 | (check-true (s3? ((inst s8 String) -1 -2 "c"))) 346 | 347 | ;(check-equal? (s9-x (s9 8 9 10)) 8) 348 | ;(check-equal? (s9-y (s9 8 9 10)) 9) 349 | (check-equal? (s9-z (s9 8 9 10)) 10) 350 | (check-equal? (s5-x (s9 8 9 10)) 8) 351 | (check-equal? (s5-y (s9 8 9 10)) 9) 352 | (check-equal? (s9 8 9 10) (s9 8 9 10)) 353 | ;; Bug https://github.com/racket/typed-racket/issues/451 354 | ;(check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") 355 | ; (Struct s5)))) 356 | (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") 357 | (Struct (s5 Number Symbol))))) 358 | (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") 359 | (s5 Number Symbol)))) 360 | (check-not-exn (λ () (ann ((inst s9 Number Symbol String) 8 'i "j") 361 | (s5 Any Any)))) 362 | (check-true (s5? ((inst s9 Number Symbol String) -1 'i "j"))) 363 | (check-not-equal? (s10 11 12 13) (s10 11 12 13)) 364 | (check-not-equal? (s11 14 15 16) (s11 14 15 16))) 365 | 366 | ;; Test define-struct/exec 367 | (begin 368 | (define-struct/exec se0 () 369 | ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) 370 | [(λ (self v) (cons self v)) : (→ se0 Any (Pairof se0 Any))]) 371 | (define-struct/exec se1 ([x : Number]) 372 | ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) 373 | [(λ (self v) (cons self v)) : (→ se1 Any (Pairof se1 Any))]) 374 | (define-struct/exec se2 ([x : Number] [y : Number]) 375 | [(λ (self v) (cons self v)) : (→ se2 Any (Pairof se2 Any))]) 376 | (define-struct/exec (se3 se2) ([z : String]) 377 | [(λ (self v w) (list self v w)) 378 | ;: (∀ (A B) (→ se3 A B (List se2 A B)))]) 379 | : (→ se3 Any Any (List se2 Any Any))]) 380 | (define-struct/exec (se4 se2) ([z : String]) 381 | [(λ (self v w) (list self v w)) 382 | ;: (∀ (A B) (→ se4 A B (List se2 A B)))]) 383 | : (→ se4 Any (→ Number Number) (List se2 Any (→ Number Number)))]) 384 | 385 | (check (λ (a b) (not (equal? a b))) (se0) (se0)) 386 | (check-equal? (cdr ((se0) 'a)) 'a) 387 | (check-not-exn (λ () (ann (car ((se0) 'a)) se0))) 388 | (check-true (se0? (car ((se0) 'a)))) 389 | 390 | (check (λ (a b) (not (equal? a b))) (se1 123) (se1 123)) 391 | (check-equal? (se1-x (se1 123)) 123) 392 | (check-equal? (se1-x (car ((se1 123) 'b))) 123) 393 | (check-equal? (cdr ((se1 123) 'b)) 'b) 394 | (check-not-exn (λ () (ann (car ((se1 123) 'b)) se1))) 395 | (check-true (se1? (car ((se1 123) 'b)))) 396 | 397 | (check (λ (a b) (not (equal? a b))) (se2 2 3) (se2 2 3)) 398 | (check-equal? (se2-x (se2 2 3)) 2) 399 | (check-equal? (se2-y (se2 2 3)) 3) 400 | (check-equal? (se2-x (car ((se2 2 3) 'c))) 2) 401 | (check-equal? (se2-y (car ((se2 2 3) 'c))) 3) 402 | (check-equal? (cdr ((se2 2 3) 'c)) 'c) 403 | (check-not-exn (λ () (ann (car ((se2 2 3) 'c)) se2))) 404 | (check-true (se2? (car ((se2 2 3) 'c)))) 405 | 406 | (check (λ (a b) (not (equal? a b))) (se3 4 5 "f") (se3 4 5 "f")) 407 | (check-equal? (se2-x (se3 4 5 "f")) 4) 408 | (check-equal? (se2-y (se3 4 5 "f")) 5) 409 | (check-equal? (se3-z (se3 4 5 "f")) "f") 410 | (check-equal? (se2-x (car ((se3 4 5 "f") 'd 'e))) 4) 411 | (check-equal? (se2-y (car ((se3 4 5 "f") 'd 'e))) 5) 412 | (check-equal? (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))]) 413 | (if (se3? ret) 414 | (se3-z ret) 415 | "wrong type!")) 416 | "f") 417 | (check-equal? (cadr ((se3 4 5 "f") 'd 'e)) 'd) 418 | (check-equal? (caddr ((se3 4 5 "f") 'd 'e)) 'e) 419 | (check-equal? ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12) 420 | 24) 421 | (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2))) 422 | (check-true (se2? (car ((se3 4 5 "f") 'd 'e)))) 423 | (check-true (se3? (car ((se3 4 5 "f") 'd 'e))))) 424 | 425 | ;; Test ann 426 | (let () 427 | (define-type-expander (Repeat stx) 428 | (syntax-case stx () 429 | [(_ t n) #`(List #,@(map (λ (x) #'t) 430 | (range (syntax->datum #'n))))])) 431 | (check-equal? (ann (ann '(1 2 3) 432 | (Repeat Number 3)) 433 | (List Number Number Number)) 434 | '(1 2 3))) 435 | 436 | ;; Test inst 437 | (let () 438 | (define-type-expander (Repeat stx) 439 | (syntax-case stx () 440 | [(_ t n) #`(List #,@(map (λ (x) #'t) 441 | (range (syntax->datum #'n))))])) 442 | 443 | (: f (∀ (A B C D) (→ (Pairof A B) (Pairof C D) (List A C B D)))) 444 | (define (f x y) (list (car x) (car y) (cdr x) (cdr y))) 445 | 446 | (check-equal? ((inst f 447 | (Repeat Number 3) 448 | (Repeat String 2) 449 | (Repeat 'x 1) 450 | (Repeat undefined-type 0)) 451 | '((1 2 3) . ("a" "b")) 452 | '((x) . ())) 453 | '((1 2 3) (x) ("a" "b") ()))) 454 | 455 | ;; Test let 456 | (begin 457 | (check-equal? (ann (let loop-id ([x 1]) 458 | (if (equal? x 2) 459 | x 460 | (loop-id 2))) 461 | Any) 462 | 2) 463 | (check-equal? (let () 'x) 'x) 464 | (check-equal? (ann (let #:∀ (T) ([a : T 3] 465 | [b : (Pairof T T) '(5 . 7)]) 466 | (cons a b)) 467 | (Pairof Number (Pairof Number Number))) 468 | '(3 5 . 7))) 469 | 470 | ;; Test let* 471 | (let () 472 | (define-type-expander (Repeat stx) 473 | (syntax-case stx () 474 | [(_ t n) #`(List #,@(map (λ (x) #'t) 475 | (range (syntax->datum #'n))))])) 476 | 477 | (check-equal? (let* ([x* : (Repeat Number 3) '(1 2 3)] 478 | [y* : (Repeat Number 3) x*]) 479 | y*) 480 | '(1 2 3))) 481 | 482 | ;; Test let-values 483 | (let () 484 | (define-type-expander (Repeat stx) 485 | (syntax-case stx () 486 | [(_ t n) #`(List #,@(map (λ (x) #'t) 487 | (range (syntax->datum #'n))))])) 488 | 489 | (check-equal? (ann (let-values 490 | ([([x : (Repeat Number 3)]) 491 | (list 1 2 3)]) 492 | (cdr x)) 493 | (List Number Number)) 494 | '(2 3)) 495 | 496 | (check-equal? (ann (let-values 497 | ([([x : (Repeat Number 3)] [y : Number]) 498 | (values (list 1 2 3) 4)]) 499 | (cons y x)) 500 | (Pairof Number (List Number Number Number))) 501 | '(4 . (1 2 3))) 502 | 503 | (check-equal? (ann (let-values 504 | ([(x y) 505 | (values (list 1 2 3) 4)]) 506 | (cons y x)) 507 | (Pairof Number (List Number Number Number))) 508 | '(4 . (1 2 3)))) 509 | 510 | ;; Test make-predicate 511 | (let () 512 | (define-type-expander (Repeat stx) 513 | (syntax-case stx () 514 | [(_ t n) #`(List #,@(map (λ (x) #'t) 515 | (range (syntax->datum #'n))))])) 516 | (check-equal? ((make-predicate (Repeat Number 3)) '(1 2 3)) #t) 517 | (check-equal? ((make-predicate (Repeat Number 3)) '(1 "b" 3)) #f)) 518 | 519 | ;; row-inst 520 | (let-syntax ([when-row-inst-is-defined 521 | (λ (stx) 522 | (syntax-case stx () 523 | [(_ body) 524 | (if (or (identifier-binding #'row-inst) 525 | (version<=? "6.7" (version))) 526 | #'body 527 | #'(void))]))]) 528 | (when-row-inst-is-defined 529 | (let () 530 | ;; Example taken from the docs 531 | (: id (All (r #:row) 532 | (-> (Class #:row-var r) (Class #:row-var r)))) 533 | (define (id cls) cls) 534 | (define result ((row-inst id (Row (field [x Integer]))) 535 | (class object% (super-new) (field [x : Integer 0])))) 536 | (ann result (Class (field (x Integer)))) 537 | (void)))) 538 | 539 | ;; Tests written while debugging 540 | (begin 541 | (let () 542 | (define-type-expander flob 543 | (λ (stx) #'(All (abc) (List abc)))) 544 | 545 | (ann '(a) ((flob) Symbol)) 546 | 547 | (ann '(42) ((Let ([flob (Λ (_ arg) 548 | #'((∀ (abc) 549 | (List abc)) arg))]) 550 | flob) 551 | Integer)) 552 | 553 | (ann '(1 2 3) ((∀ (abc) 554 | (Listof abc)) 555 | Integer)) 556 | 557 | (ann '(1 2 3) ((Let () 558 | (∀ (abc) 559 | (Listof abc))) 560 | Integer)) 561 | (void)) 562 | 563 | (let () 564 | (test-expander 565 | ((Let () (∀ (A1) (Let () A1))) Number) 566 | Number)) 567 | 568 | (let () 569 | (ann '(1 2 3) (Listof Integer)) 570 | 571 | (define-type (poly1 ty) 572 | (Listof ty)) 573 | 574 | (ann '(1 2 3) (poly1 Integer)) 575 | 576 | (define-type (poly2 ty) 577 | (Listof ty)) 578 | 579 | (ann '(1 2 3) (poly2 Integer)) 580 | 581 | (ann '(1 2 3) ((∀ (ty) 582 | (Listof ty)) 583 | Integer)) 584 | 585 | (ann '(1 2 3) ((Let () 586 | (∀ (ty) 587 | (Listof ty))) 588 | Integer)) 589 | 590 | (void)) 591 | 592 | (define-for-syntax (test-use/def stx def expected-use expected-def) 593 | (let ([actual-use (syntax->datum 594 | (apply-type-expander (datum->syntax stx 'Quux) 595 | (datum->syntax stx 'Quux)))] 596 | [actual-def (syntax->datum 597 | (apply-type-expander def def))]) 598 | (check-equal? actual-use expected-use) 599 | (check-equal? actual-def expected-def))) 600 | 601 | (let () 602 | (define-type-expander (Foo stx) #'Integer) 603 | (define-type-expander (Bar stx) #'Integer) 604 | (define-type-expander (Quux stx) #'Integer) 605 | 606 | (define-type mytype1 607 | (Let ([Foo (Λ (_ T) 608 | (test-use/def #'T #'Quux 'Integer 'Integer) 609 | #'T)]) 610 | (Foo Quux))) 611 | 612 | (define-type mytype23 613 | (Let ([Quux String]) 614 | (Let ([Foo (Λ (_ T) 615 | (test-use/def #'T #'Quux 'String 'String) 616 | #'T)]) 617 | (Foo (∀ (A) 618 | (Let ([Bar (Λ (_ T) 619 | (test-use/def #'T #'Quux 'String 'String) 620 | #'T)]) 621 | (Bar (Listof A)))))))) 622 | 623 | (define-type mytype45 624 | (Let ([Foo (Λ (_ T) 625 | (test-use/def #'T #'Quux 'String 'Integer) 626 | #'T)]) 627 | (Let ([Quux String]) 628 | (Foo (∀ (A) 629 | (Let ([Bar (Λ (_ T) 630 | (test-use/def #'T #'Quux 'String 'String) 631 | #'T)]) 632 | (Bar (Listof A)))))))) 633 | 634 | (define-type mytype67 635 | (Let ([Foo (Λ (_ T) 636 | (test-use/def #'T #'Quux 'Integer 'Integer) 637 | #'T)]) 638 | (Foo (Let ([Quux String]) 639 | (∀ (A) 640 | (Let ([Bar (Λ (_ T) 641 | (test-use/def #'T #'Quux 'String 'String) 642 | #'T)]) 643 | (Bar (Listof A)))))))) 644 | 645 | (define-type mytype89 646 | (Let ([Foo (Λ (_ T) 647 | (test-use/def #'T #'Quux 'Integer 'Integer) 648 | #'T)]) 649 | (Foo (∀ (A) 650 | (Let ([Quux String]) 651 | (Let ([Bar (Λ (_ T) 652 | (test-use/def #'T #'Quux 'String 'String) 653 | #'T)]) 654 | (Bar (Listof A)))))))) 655 | 656 | (void)) 657 | 658 | (let () 659 | (test-expander ((Let ([F (Λ (_ T) #'T)]) F) String) 660 | String) 661 | (test-expander ((Let ([F (Λ (_ T) #'(List T))]) F) String) 662 | (List String))) 663 | 664 | ;; Please don't ever do that in practice :) ! 665 | (let () 666 | (test-expander (Let ([Loot Number]) 667 | ((Let ([Loot Let]) Loot) ([AAA Number]) 668 | AAA)) 669 | Number) 670 | (test-expander (Let ([Loot Number]) 671 | ((Let ([Loot Let]) Loot) ([Let Loot]) 672 | Let)) 673 | Number) 674 | (test-expander (Let ([Loot Number]) 675 | ((Let ([Loot Let]) Loot) ([Loot String]) 676 | Loot)) 677 | String))) 678 | 679 | ;; more tests 680 | (begin 681 | (test-expander ((∀ (A) ((∀ (A) ((∀ (A) ((∀ (A) A) A)) A)) A)) Number) 682 | Number) 683 | (test-expander (Let ([A Number]) 684 | (Let ([A A]) 685 | (Let ([A A]) 686 | (Let ([A A]) 687 | A)))) 688 | Number) 689 | (test-expander (Let* ([A Number] 690 | [A A] 691 | [A A] 692 | [A A] 693 | [A A]) 694 | A) 695 | Number) 696 | (test-expander (Let* ([A Number] 697 | [A (List A)] 698 | [A (Pairof A A)] 699 | [A (Vector A)] 700 | [A (Set A)]) 701 | A) 702 | (Set (Vector (Pairof (List Number) (List Number))))) 703 | 704 | ;; Adjusted from http://www.cs.utah.edu/~mflatt/scope-sets/ 705 | ;; #%28part._.Macro_.Definitions_in_a_.Recursive_.Scope%29 706 | (test-expander (Letrec ([Identity (Λ (_ misc-id) 707 | #'(∀ (X) 708 | (Let ([misc-id String]) 709 | X)))]) 710 | ((Identity X) Number)) 711 | Number) 712 | (test-expander (Letrec ([Identity (Λ (_ misc-id) 713 | #'(∀ (misc-id) 714 | (Let ([X String]) 715 | misc-id)))]) 716 | ((Identity X) Number)) 717 | Number) 718 | (test-expander (Letrec ([GetY (Λ (_ misc-id) 719 | (datum->syntax #'misc-id 'Y))]) 720 | (Let ([Y Number]) (GetY X))) 721 | Number) 722 | (test-expander (Letrec ([GetY (Λ (_ misc-id) 723 | (datum->syntax #'misc-id 'Y))]) 724 | ((∀ (Y) (GetY X)) Number)) 725 | Number)) 726 | 727 | ;; Tests for Syntax 728 | (let () 729 | (test-expander #'a (Syntaxof 'a)) 730 | (test-expander #'(a) (Syntaxof (List (Syntaxof 'a)))) 731 | (test-expander #'(a . b) (Syntaxof (Pairof (Syntaxof 'a) (Syntaxof 'b)))) 732 | (test-expander #'(a . (b)) 733 | (Syntaxof (Pairof (Syntaxof 'a) 734 | (Syntaxof (List (Syntaxof 'b)))))) 735 | (test-expander #'(a b) (Syntaxof (List (Syntaxof 'a) (Syntaxof 'b)))) 736 | (test-expander #'(a b . c) 737 | (Syntaxof (List* (Syntaxof 'a) (Syntaxof 'b) (Syntaxof 'c)))) 738 | (test-expander #'(a b . (c)) 739 | (Syntaxof (List* (Syntaxof 'a) 740 | (Syntaxof 'b) 741 | (Syntaxof (List (Syntaxof 'c))))))) 742 | 743 | ;; Small typo 744 | (let () 745 | (test-expander ((No-Expand List) 'a 'b) (List 'a 'b))) 746 | -------------------------------------------------------------------------------- /scribblings/type-expander.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{Type expander library} 4 | @author{@author+email["Suzanne Soy" "racket@suzanne.soy"]} 5 | 6 | @defmodule[type-expander 7 | #:use-sources [(lib "type-expander/type-expander.hl.rkt") 8 | (lib "type-expander/more-expanders.hl.rkt")]] 9 | 10 | @require[racket/require 11 | scribble/example 12 | @for-syntax[racket/base] 13 | @for-label[type-expander 14 | type-expander/expander 15 | (subtract-in typed/racket/base 16 | type-expander 17 | type-expander/expander) 18 | (only-in racket/base [... …]) 19 | (prefix-in racket/base: racket/base) 20 | syntax/stx 21 | racket/list 22 | syntax/parse 23 | syntax/parse/experimental/template 24 | auto-syntax-e 25 | debug-scopes]] 26 | 27 | @(require (for-syntax syntax/strip-context 28 | syntax/stx 29 | racket/syntax)) 30 | @(define-syntax (orig stx) 31 | (syntax-case stx () 32 | [(_ name ...) 33 | (with-syntax ([(prefixed ...) 34 | (stx-map (λ (id) (format-id id "orig:~a" id)) 35 | #'(name ...))]) 36 | #`(begin 37 | (module #,(syntax-local-introduce #'orig-module) . 38 | #,(strip-context 39 | #'(racket/base 40 | (require (for-label (only-meta-in 0 (only-in typed/racket 41 | name ...)))) 42 | (require scribble/manual) 43 | (define prefixed @racket[name]) ... 44 | (provide prefixed ...)))) 45 | (require #,(syntax-local-introduce #''orig-module))))])) 46 | 47 | @(orig 48 | class 49 | ;; 50 | define-type 51 | ;; TODO: add all-defined-out in prims.rkt 52 | ;; top-interaction.rkt 53 | :type 54 | :print-type 55 | :query-type/args 56 | :query-type/result 57 | ;; case-lambda.rkt 58 | case-lambda 59 | case-lambda: 60 | pcase-lambda: 61 | ;; (submod "prims-contract.rkt" forms) 62 | require/opaque-type 63 | ;require-typed-struct-legacy 64 | require-typed-struct 65 | ;require/typed-legacy 66 | require/typed 67 | require/typed/provide 68 | require-typed-struct/provide 69 | cast 70 | make-predicate 71 | define-predicate 72 | ;; prims.rkt 73 | define-type-alias 74 | define-new-subtype 75 | define-typed-struct 76 | define-typed-struct/exec 77 | ann 78 | inst 79 | : 80 | define-struct: 81 | define-struct 82 | struct 83 | struct: 84 | λ: 85 | lambda: 86 | lambda 87 | λ 88 | define 89 | let 90 | let* 91 | letrec 92 | let-values 93 | letrec-values 94 | let/cc 95 | let/ec 96 | let: 97 | let*: 98 | letrec: 99 | let-values: 100 | letrec-values: 101 | let/cc: 102 | let/ec: 103 | for 104 | for/list 105 | for/vector 106 | for/hash 107 | for/hasheq 108 | for/hasheqv 109 | for/and 110 | for/or 111 | for/sum 112 | for/product 113 | for/lists 114 | for/first 115 | for/last 116 | for/fold 117 | for* 118 | for*/list 119 | for*/lists 120 | for*/vector 121 | for*/hash 122 | for*/hasheq 123 | for*/hasheqv 124 | for*/and 125 | for*/or 126 | for*/sum 127 | for*/product 128 | for*/first 129 | for*/last 130 | for*/fold 131 | for/set 132 | for*/set 133 | do 134 | do: 135 | with-handlers 136 | define-struct/exec: 137 | define-struct/exec) 138 | 139 | @(define eval-factory 140 | (make-eval-factory (list 'typed/racket 'type-expander))) 141 | 142 | This library is implemented using literate programming. The 143 | implementation details are presented in the 144 | @other-doc['(lib 145 | "type-expander/scribblings/type-expander-implementation.scrbl")] 146 | document. 147 | 148 | It enhances @racketmodname[typed/racket] with 149 | @deftech[#:key "type expander"]{type expanders}, which are 150 | special macros that can appear wherever a regular type is 151 | usually expected, and must expand to a type. Type expanders 152 | are to types what 153 | @tech[#:doc '(lib "scribblings/reference/reference.scrbl") 154 | #:key "match expander"]{ 155 | match expanders} are to @racket[match] patterns. 156 | 157 | It is based on 158 | @hyperlink[(string-append "https://github.com/racket/racket/compare/" 159 | "master...takikawa:tr-type-expander")]{ 160 | Asumu Takikawa's type expanders} (see also his 161 | @hyperlink["https://github.com/racket/racket/pull/604"]{original pull request}). 162 | Asumu Takikawa's work attempted to integrate type expanders 163 | directly into Typed/Racket. This project instead implements 164 | type expanders as a library, which does not need any changes 165 | to the core Typed/Racket codebase. This shows the 166 | extensibility of Typed/Racket thanks to macros, and could 167 | serve as the basis for other projects which need to alter 168 | how Typed/Racket handles types. 169 | 170 | The input for a type expander is the syntax used to call 171 | it, just as the input to a macro is the syntax used to call 172 | it. The output should be a type, which can itself contain 173 | type expanders. 174 | 175 | This library works by shadowing the definitions of 176 | @orig::, @orig:define, @orig:lambda @etc from 177 | @racketmodname[typed/racket] with versions which support 178 | type expanders. 179 | 180 | @section{@(hash-lang) and module languages based on 181 | @racketmodname[type-expander]} 182 | 183 | @subsection{@(hash-lang) combining @racketmodname[type-expander] and 184 | @racketmodname[typed/racket]} 185 | 186 | @defmodulelang[type-expander 187 | #:link-target? #f]{ 188 | The @racket[#,(hash-lang) #,(racketmodname type-expander)] language works like 189 | @racket[#,(hash-lang) #,(racketmodname typed/racket)], but it initially imports 190 | the forms overridden by @racketmodname[type-expander], instead of importing 191 | the original identifiers defined by @racket[typed/racket]. 192 | 193 | This language cannot be used as a module language, instead use 194 | @racketmodname[type-expander/lang] which provides the same bindings.} 195 | 196 | @subsection{Module language combining @racketmodname[type-expander] and 197 | @racketmodname[typed/racket]} 198 | 199 | @defmodulelang[type-expander/lang]{ 200 | This language is equivalent to 201 | @racket[#,(hash-lang) #,(racketmodname type-expander)], but can also be used as 202 | a module language.} 203 | 204 | @subsection{@(hash-lang) and module language combining 205 | @racketmodname[type-expander] and @racketmodname[typed/racket/base]} 206 | 207 | @defmodulelang[type-expander/base]{ 208 | This language is similar to @racketmodname[type-expander/lang], but it 209 | exports the identifiers from @racketmodname[typed/racket/base] instead of 210 | @racket[typed/racket].} 211 | 212 | 213 | @section{Defining new type expanders} 214 | 215 | @defform*[((define-type-expander (name stx) . body) 216 | (define-type-expander name transformer-function)) 217 | #:grammar ([name Identifier] 218 | [stx Identifier] 219 | [transformer-function (expr/c (-> syntax? syntax?))])]{ 220 | The @racket[define-type-expander] form binds 221 | @racket[_name] to a type expander, which can be used in 222 | places where a type would normally be expected. 223 | 224 | For example, one could define the @racket[HomogeneousList] 225 | type expander, which accepts a type @racket[_t] and an 226 | integer @racket[_n], and produces a @racket[List] type with 227 | @racket[_n] elements, each of type @racket[_t]: 228 | 229 | @racketblock[ 230 | (define-type-expander (HomogeneousList stx) 231 | (syntax-case stx () 232 | [(_ t n) 233 | (number? (syntax-e #'n)) 234 | (with-syntax ([(tᵢ ...) (stx-map (const #'t) 235 | (range (syntax-e #'n)))]) 236 | #'(List tᵢ ...))]))]} 237 | 238 | @subsection{Attaching type expanders to existing identifiers} 239 | 240 | @defform[(patch-type-expander name transformer-function) 241 | #:grammar ([name Identifier] 242 | [transformer-function (expr/c (-> syntax? syntax?))])]{ 243 | This macro records in a global table that @racket[name] should behave 244 | according to the given @racket[transformer-function], when used as a type. 245 | 246 | It allows attaching type expanders to existing identifiers, without shadowing 247 | them. It is used for example to attach the type expanders for @racket[quote], 248 | @racket[quasiquote], @racket[syntax] and @racket[quasisyntax] which are 249 | described below, and also for the @racket[curry] type expander.} 250 | 251 | @section{Using a type expander} 252 | 253 | The @racket[HomogeneousList] type expander defined above could be 254 | used in many of @racketmodname[typed/racket]'s forms. 255 | 256 | @racketblock[ 257 | (define-type three-ints (HomogeneousList 3 Integer)) 258 | (define (incr3 [x : three-ints]) : (HomogeneousList 3 Integer) 259 | (map add1 x)) 260 | (ann (incr3 '(1 2 3)) (HomogeneousList 3 Integer))] 261 | 262 | Type expanders can produce types which may contain other 263 | uses of type expanders, much in the same way as macros can 264 | expand to code calling other macros. The type expander can 265 | also produce directly a call to another type expander, just 266 | as a macro can expand to a call to another macro, without 267 | any extra surrounding syntax. 268 | 269 | @; TODO: examples 270 | 271 | Contrarily to macros, if a call to a type expander is in the 272 | first position of more arguments, then the nested call is 273 | first expanded, and can produce the name of a second 274 | expander which will use the outer arguments, or can simply 275 | produce a polymorphic type which will be applied to the 276 | arguments. More than two levels of nesting are possible. 277 | 278 | @; TODO: examples with two levels and more. 279 | 280 | @section{Debugging type expanders} 281 | 282 | @defform*[[(debug-type-expander #t) 283 | (debug-type-expander #f)]]{ 284 | The first form enables printing of debugging information while expanding 285 | types, and the second form disables that behaviour. Debugging information is 286 | not printed by default. 287 | 288 | Currently, when debugging information is enabled, the type expander prints at 289 | each step a human-readable representation of the syntax object it is about to 290 | expand, and once an expansion step finishes, it prints the original syntax 291 | object as well as its expanded form. The identifiers are adorned with 292 | superscripts indicating the scopes present on them. See the documentation for 293 | the debugging tool @racket[+scopes] for more details.} 294 | 295 | @section{Compile-time aspects of type expanders} 296 | 297 | @defmodule[type-expander/expander 298 | #:use-sources 299 | [(submod (lib "type-expander/type-expander.hl.rkt") expander) 300 | (submod (lib "type-expander/type-expander.hl.rkt") main)]] 301 | 302 | @defproc[(expand-type [stx Type]) PlainType]{ 303 | Fully expands the type @racket[stx], which may contain any 304 | number of calls to type expanders. If those calls result in 305 | more type expanders, those are expanded too.} 306 | 307 | @defproc[(apply-type-expander [type-expander-stx Identifier] [stx Syntax]) 308 | Type]{ 309 | Produces the result of applying the type expander bound to 310 | @racket[type-expander-stx] to the syntax @racket[stx]. 311 | Normally, the syntax @racket[stx] would be of the form 312 | @racket[(type-expander-stx arg …)] (similar to a macro 313 | call) or simply @racket[type-expander-stx] (similar to an 314 | @tech[#:doc '(lib 315 | "scribblings/guide/guide.scrbl")]{identifier 316 | macro}). It is however possible to pass arbitrary syntax 317 | to the type expander, just as it is possible for macros 318 | (for example @racket[set!] calls 319 | @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{ 320 | assignment transformer} macros with the syntax 321 | @racket[(set! macro-name arg …)] as an argument).} 322 | 323 | @deftogether[ 324 | (@defthing[prop:type-expander 325 | (struct-type-property/c 326 | (or/c exact-positive-integer? 327 | (→ prop:type-expander? any/c any/c) 328 | (→ any/c any/c)))] 329 | @defproc[(prop:type-expander? [v any/c]) boolean?] 330 | @defproc[(prop:type-expander-ref [v prop:type-expander?]) any/c])]{ 331 | A 332 | @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{ 333 | structure type property} to identify structure types that 334 | act as @tech[#:key "type expander"]{type expanders} like 335 | the ones created by @racket[define-type-expander]. 336 | 337 | The property value must be a procedure of arity 1 or 2, or an 338 | @racket[exact-nonnegative-integer?] designating a field index within the 339 | structure which contains such a procedure. If the procedure's arity includes 340 | 2, then the first argument is the structure itself (which satisfies 341 | @racket[prop:type-expander?]), and the second argument is the syntax object to 342 | transform. Otherwise, the single argument is the syntax object to transform. 343 | 344 | The procedure serves as a syntax transformer when 345 | expanding the use of a type expander. If the type expander 346 | was in the first position of a syntax list (i.e. it looks 347 | like a macro or function call), then the whole syntax list 348 | is passed as an argument. Otherwise, just the identifier is 349 | passed as an argument, exactly as what would be done when 350 | calling an 351 | @tech[#:doc '(lib 352 | "scribblings/guide/guide.scrbl")]{identifier macro}. The 353 | procedure can support other use patterns if desired, so 354 | that it would be possible in principle to implement special 355 | type forms that behave in a way similar to 356 | @secref["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")].} 357 | 358 | @subsection{Syntax class for @racketid[:]} 359 | 360 | @defidform[#:kind "syntax-parse syntax class" 361 | colon]{ 362 | This library shadows the @orig:: identifier from 363 | @racketmodname[typed/racket] with a new definition 364 | @racket[:], adjusted to handle type expanders. Programs 365 | using the @racketmodname[type-expander] library will 366 | therefore use our version of @racket[:]. The @racket[:] 367 | identifier provided by this library is not 368 | @racket[free-identifier=?] with the original @orig:: from 369 | @racketmodname[typed/racket]. This has an impact when 370 | writing patterns for the @racketmodname[syntax/parse] 371 | library, as the two identifiers @racket[:] and @orig:: are 372 | not the same from the point of view of the 373 | @racket[~literal] pattern. 374 | 375 | The @racket[colon] syntax class is provided 376 | @racket[for-syntax] by this library, and can be used in 377 | @racket[syntax-parse] patterns, using @racket[c:colon] for 378 | example. It matches both the original @orig:: and the new 379 | @racket[:], but not other @racketid[:] identifiers. 380 | 381 | It can be used to write macros which expect either 382 | @racketid[:] identifier.} 383 | 384 | @subsection{Syntax classes for types} 385 | 386 | @defidform[#:kind "syntax-parse syntax class" 387 | type]{ 388 | Matches a type. For now, this is just an alias for @racket[expr], because types 389 | can contain arbitrary syntax thanks to type expanders.} 390 | 391 | @defthing[stx-type/c flat-contract?]{ 392 | Flat contract which recognises syntax objects representing types. For now, 393 | this is just an alias for @racket[syntax?], because types can contain 394 | arbitrary syntax thanks to type expanders. 395 | 396 | Future versions may implement this as a non-flat contract, in order to be 397 | able to check that in a macro's result, the syntax for a type is not used as 398 | an expression, and vice versa.} 399 | 400 | @defidform[#:kind "syntax-parse syntax class" 401 | type-expand!]{ 402 | Matches a type @racket[_t], and provides an attribute named @racket[expanded] 403 | which contains the result of @racket[(expand-type #'_t)]. For now, 404 | @racket[type-expand] does not perform any check other than verifying that 405 | @racket[_t] is an @racket[expr], because types can contain arbitrary syntax 406 | thanks to type expanders.} 407 | 408 | @section{multi-id} 409 | 410 | @; TODO: separate multi-id or type-expander into two packages, so that we can 411 | @; write @racketmodname[multi-id] without causing a circular dependency: 412 | Type expanders are supported by the multi-id library. It is 413 | therefore easy to define an identifier which acts as a type 414 | expander and match expander as well as a regular racket 415 | macro and/or 416 | @tech[#:doc '(lib 417 | "scribblings/guide/guide.scrbl")]{identifier macro}. This 418 | can be useful to define feature-rich data structures, which 419 | need to provide all of the above features. 420 | 421 | @section{Expansion model for type expanders} 422 | 423 | The expansion model for type expanders is similar to the expansion model for 424 | macros. There are a few differences, however, which are presented below. 425 | 426 | @itemlist[ 427 | @item{When a form like @racket[(f args ... . rest)] is encountered, if its 428 | first element, @racket[f], is a type expander, the type expander is applied to 429 | the whole form. If @racket[f] is a special identifier (e.g. like @racket[Let] 430 | or @racket[Rec]), then the form is handled according to the special 431 | identifier's rules. Otherwise, the @racket[f] form is expanded, and the result 432 | @racket[(e args ... . rest)] is expanded once again (@racket[e] being the 433 | result of the expansion of @racket[f]). 434 | 435 | In comparison, the ``official'' macro expander for Racket would, in the last 436 | case, expand @racket[f] on its own, and then expand the arguments one by one 437 | without re-considering the form as a whole. 438 | 439 | 440 | With the type expander, during the second expansion pass for the form, if the 441 | @racket[e] identifier is a type expander it is applied to the whole form. If 442 | @racket[e] is a special identifier, the form is processed following that 443 | identifier's rules. Otherwise, the @racket[e] form is left intact, and the 444 | arguments @racket[args ...] and @racket[rest] are expanded each in turn. 445 | 446 | In comparison, the ``official'' macro expander would have fully expanded 447 | @racket[e] in isolation (e.g. as an identifier macro), without letting it take 448 | over the arguments.} 449 | @item{With the ``official'' macro expander, all forms at the same lexical 450 | scoping level are expanded before expanding the contents of @racket[let] 451 | forms. 452 | 453 | In contrast, the type expander expands the contents of @racket[Let] forms in 454 | the same order as other forms. It further replaces the @racket[Let] forms by 455 | their contents, so that the following type: 456 | 457 | @racketblock[((Let ([Foo Pairof]) Foo) Number String)] 458 | 459 | gets expanded by replacing @racket[(Let ([Foo Pairof]) Foo)] by its contents 460 | (i.e. the @racket[Foo] identifier in this case): 461 | 462 | @racketblock[(Foo Number String)] 463 | 464 | The @racket[Foo] identifier is still bound to @racket[Pairof], so this new 465 | type expression gets expanded to: 466 | 467 | @racketblock[(Pairof Number String)] 468 | 469 | This means that identifiers bound by @racket[Let] forms can escape their 470 | scope, but are still attached to their defining scope.} 471 | @item{With the current implementation of the type expander, 472 | @racket[syntax-local-value] ignores types bound by @racket[Let] forms. A 473 | future version of this library will (hopefully) either fix this problem, or 474 | provide an alternative @racket[syntax-local-type-value] which takes those 475 | bindings into account.}] 476 | 477 | @section{Built-in type expanders} 478 | 479 | There are several built-in expanders. Some are documented 480 | here, while others are listed in 481 | @secref["Cases_handled_by_expand-type" 482 | #:doc '(lib "type-expander/type-expander.hl.rkt")]. 483 | Their API should be considered unstable, and may change in 484 | the future. 485 | 486 | @subsection{Let} 487 | 488 | @defform[#:kind "type expander" 489 | (Let ([Vᵢ Eᵢ] …) τ) 490 | #:grammar 491 | ([Vᵢ Identifier] 492 | [Eᵢ Type] 493 | [τ Type])]{ 494 | The @racket[Let] form binds each type expression 495 | @racket[Eᵢ] (which may contain uses of type expanders bound 496 | outside of the @racket[Let] form) to the identifier @racket[Vᵢ]. 497 | The type @racket[τ] can contain type expanders and can 498 | refer to occurrences of the bound @racket[Vᵢ] identifiers, 499 | which will expand to @racket[Eᵢ]. The @racket[Let] form therefore 500 | behaves is a way similar to @racket[let-syntax]. 501 | 502 | @examples[#:eval (eval-factory) 503 | (ann '(1 2 3) 504 | (Let ([Foo Number]) 505 | (Listof Foo))) 506 | (eval:error (ann '(1 2 3) 507 | (Listof Foo)))] 508 | 509 | @examples[#:eval (eval-factory) 510 | (ann '([1 . "a"] [2 . b] [3 . 2.71]) 511 | (Let ([Foo (Λ (_ T) 512 | #'(Pairof Number T))]) 513 | (List (Foo String) 514 | (Foo Symbol) 515 | (Foo Float))))] 516 | 517 | @examples[#:eval (eval-factory) 518 | (ann '(a b c) 519 | (Let ([Foo Number]) 520 | (Let ([Foo String]) 521 | (Let ([Foo Symbol]) 522 | (Listof Foo))))) 523 | (ann '(a b c) 524 | (Let ([Foo Number]) 525 | (Listof (Let ([Foo String]) 526 | (Let ([Foo Symbol]) 527 | Foo)))))]} 528 | 529 | @subsection{Letrec} 530 | 531 | @defform[#:kind "type expander" 532 | (Letrec ([Vᵢ Eᵢ] …) τ)]{ 533 | Like @racket[Let], but all the @racket[Vᵢ] identifiers are bound within all 534 | the @racket[Eᵢ] type expressions. This means the type expression within an 535 | @racket[Eᵢ] can refer to any @racket[Vᵢ] of the same @racket[Letrec].} 536 | 537 | 538 | @subsection{Let*} 539 | 540 | @defform[#:kind "type expander" 541 | (Let* ([Vᵢ Eᵢ] …) τ)]{ 542 | Like @racket[Let], but all the preceding @racket[Vᵢ] identifiers are bound 543 | each @racket[Eᵢ] type expression. This means the type expression within an 544 | @racket[Eᵢ] can refer to any @racket[Vᵢ] already bound above it, but not to 545 | the @racket[Vᵢ] it is being bound to, nor to the following @racket[Vᵢ].} 546 | 547 | @subsection{Λ} 548 | 549 | @defform[#:kind "type expander" 550 | (Λ formals . body) 551 | #:grammar 552 | ([stx Identifier])]{ 553 | 554 | The @racket[Λ] form (a capital @racketid[λ]) can be used to construct an 555 | anonymous type expander. It is equivalent to replacing the whole 556 | @racket[(Λ formals . body)] form with @racket[_generated-id], where 557 | @racket[_generated-id] is defined as a named type expander as follows: 558 | 559 | @racketblock[(define-type-expander (_gen-id _gen-stx-id) 560 | (auto-syntax-case _gen-stx-id () 561 | [formals (let () . body)]))] 562 | 563 | where @racket[_id] and @racket[_gen-stx-id] are fresh unique identifiers. 564 | 565 | Since @racket[Λ] relies on @racket[auto-syntax-case], the syntax pattern 566 | variables bound by @racket[formals] can also be used outside of syntax 567 | templates, in which case they evaluate to @racket[(syntax->datum #'pvar)]. 568 | 569 | @examples[#:eval (eval-factory) 570 | #:escape UNSYNTAX 571 | (eval:no-prompt (require (for-syntax racket/list racket/function))) 572 | (ann '(1 2 3 4) 573 | ((Λ (_ T n) 574 | #`(List #,@(map (const #'T) (range n)))) 575 | Number 4))]} 576 | 577 | @subsection{Quasiquote} 578 | 579 | The type expander library also adds support for 580 | quasiquoting in types: The type @racket[`(a (1 b) ,String)] 581 | is expanded to @racket[(List 'a (List 1 'b) String)]. 582 | 583 | @examples[#:eval (eval-factory) 584 | (ann '(a (1 b) "foo") 585 | `(a (1 b) ,String))] 586 | 587 | The @racket[quote], @racket[quasiquote], @racket[syntax] and 588 | @racket[quasisyntax] identifiers are interpreted specially within type 589 | expressions. The @racket[quote] identifier can be used to describe a type 590 | matching containing only the quoted value. Similarly, @racket[syntax] can be 591 | used to describe the type of the quoted syntax object, without the need to 592 | insert @racket[Syntaxof] by hand around each part of the type. Note that the 593 | type @racket[#'(a b c)] will match the syntax object @racket[#'(a b c)], but 594 | not the syntax object @tt{#'(a b . (c))}, i.e. the generated type is 595 | sensitive to the distinction between syntax pairs and syntax lists. It is 596 | possible that a future version of this library provides another type expander 597 | which accepts both. The @racket[quasiquote] and @racket[quasisyntax] forms 598 | allow the use of @racket[unquote] and @racket[unsyntax], respectively. 599 | 600 | @subsection{Currying type expanders} 601 | 602 | The @racket[curry] special type-expander form can be used to curry in some 603 | arguments to a type expander. 604 | 605 | @examples[#:eval (eval-factory) 606 | (ann '([a . 1] [a . b] [a . "c"]) 607 | (Let ([PA (curry Pairof 'a)]) 608 | (List (PA 1) (PA 'b) (PA "c"))))] 609 | 610 | @section{Common issues (FAQ)} 611 | 612 | @(require (only-in scribble/eval interaction)) 613 | @itemlist[ 614 | @item{Explicitly requiring @racketmodname[typed/racket] 615 | causes an error: 616 | @(let ([errmsg (string-append "module: identifier already imported from" 617 | " a different source in:" "\n" 618 | " λ:" "\n" 619 | " type-expander" "\n" 620 | " typed/racket" "\n")]) 621 | @interaction[(eval:alts (require typed/racket type-expander) 622 | (eval:result "" 623 | "" 624 | errmsg))]) 625 | A required module can shadow the definitions provided by 626 | the @litchar{#lang} language, but it cannot shadow the 627 | definitions provided by other explicitly required 628 | modules. 629 | 630 | The solution is to avoid explicitly requiring 631 | @racketmodname[typed/racket], or to subtract from it the 632 | identifiers that would otherwise be shadowed anyway: 633 | 634 | @racketblock[ 635 | (require racket/require 636 | (subtract-in typed/racket type-expander) 637 | type-expander)]} 638 | @item{An error complains that a type expander is unbound: 639 | @(let ([errmsg (string-append "Type Checker: parse error in type;\n" 640 | " type name `foo' is unbound")]) 641 | @interaction[(eval:alts (module main typed/racket 642 | (module m type-expander/lang 643 | (provide foo) 644 | (define-type-expander (foo stx) #'Void)) 645 | (require 'm) 646 | (: v foo) 647 | (define v (void))) 648 | (eval:result "" 649 | "" 650 | errmsg))]) 651 | 652 | This error will be raised if the @racketmodname[type-expander] library is not 653 | @racket[require]d. It is best to double-check that a 654 | @racket[(require type-expander)] form is present, and that it is present at 655 | the appropriate meta-level (it should be loaded at the same meta-level as the 656 | use of @racket[(: var type)], @racket[(define var : type value)]). 657 | 658 | In the example above, the problem is that the module @racketid[main] requires 659 | @racket['m], but does not require @racketmodname[type-expander]. The @orig:: 660 | in @racket[(#,orig:: #,(racketid v) #,(racketid foo))] therefore comes from 661 | @racketmodname[typed/racket], and does not know how to use the @racketid[foo] 662 | type expander.} 663 | @item{@bold{Q:} Can I write a recursive type-level 664 | function? 665 | 666 | @bold{A:} Yes, but be sure that it is not infinitely 667 | recursive, as the expansion would never terminate, unlike 668 | @racketmodname[typed/racket]'s @racket[Rec], which allows 669 | truly recursive types. 670 | 671 | Furthermore, it is best to ponder the risk of 672 | combinatorial explosion, for example in 673 | @racketmodname[typed/racket], 674 | @racket[((∀ (X) (List X X)) Number)] expands internally to 675 | the type @racket[(List Number Number)]. Nesting this 676 | pattern a few times will produce a type having an 677 | in-memory representation whose size is exponential in the 678 | size of the original type declaration. A type expander can 679 | easily produce a very large type, which will bring the 680 | type checker to a crawl and/or crash it.}] 681 | 682 | @section{Overloaded @racketmodname[typed/racket] primitives} 683 | 684 | 685 | @defform[(unsafe-cast value type)]{ 686 | We define an @racket[unsafe-cast] form which is not (yet) provided by 687 | Typed/Racket. It works like @racket[cast], but does not generate a predicate 688 | to check that the value is indeed of the given type. It can therefore be used 689 | to cast values to types for which @racket[cast] would fail at compile-time 690 | when trying to generate the predicate, for example function types, or any type 691 | which translates to a 692 | @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{chaperone} 693 | contract.} 694 | 695 | @defform[(unsafe-cast/no-expand value type)]{ 696 | Like @racket[unsafe-cast], but does not expand the type. Can be useful for 697 | types which are not completely handled by @racketmodname[type-expander], for 698 | example function types with filters.} 699 | 700 | @(require (for-syntax racket/function racket/struct racket/vector)) 701 | @(define-for-syntax (strip-loc e) 702 | (cond [(syntax? e) (datum->syntax e (strip-loc (syntax-e e)) #f)] 703 | [(pair? e) (cons (strip-loc (car e)) (strip-loc (cdr e)))] 704 | [(vector? e) (vector-map strip-loc e)] 705 | [(box? e) (box (strip-loc (unbox e)))] 706 | [(prefab-struct-key e) 707 | => (λ (k) (apply make-prefab-struct 708 | k 709 | (strip-loc (struct->list e))))] 710 | [else e])) 711 | 712 | @(define-syntax (ovl stx) 713 | (syntax-case stx () 714 | [(_ name ...) 715 | (with-syntax ([(prefixed ...) 716 | (stx-map (λ (id) (format-id id "orig:~a" id)) 717 | #'(name ...))] 718 | [(stripped-name ...) 719 | (stx-map strip-loc 720 | #'(name ...))] 721 | [(stripped-ooo ...) 722 | (stx-map (compose strip-loc stx-car stx-cdr) 723 | #'([name (... ...)] ...))]) 724 | #'(list 725 | @defform[(stripped-name stripped-ooo)]{ 726 | Overloaded version of @|prefixed| from 727 | @racketmodname[typed/racket].} 728 | ...))])) 729 | 730 | @ovl[ 731 | : 732 | :type 733 | :print-type 734 | :query-type/args 735 | :query-type/result 736 | define-type 737 | define 738 | lambda 739 | λ 740 | case-lambda 741 | case-lambda: 742 | struct 743 | define-struct/exec 744 | ann 745 | cast 746 | inst 747 | let 748 | let* 749 | let-values 750 | make-predicate 751 | ;; 752 | class] 753 | 754 | @defidform[...*]{ 755 | Overloaded version of @racketid[...*], which is interpreted specially by 756 | @racketmodname[typed/racket]. It seems to be equivalent to @racket[*] for 757 | indicating the type of a rest argument within a typed @orig:λ form.} 758 | 759 | @section{Unimplemented @racketmodname[typed/racket] 760 | primitives (will be overloaded in later versions).} 761 | 762 | @(define-syntax (ovl-todo stx) 763 | (syntax-case stx () 764 | [(_ name ...) 765 | (with-syntax ([(prefixed ...) 766 | (stx-map (λ (id) (format-id id "orig:~a" id)) 767 | #'(name ...))] 768 | [(stripped-name ...) 769 | (stx-map strip-loc 770 | #'(name ...))] 771 | [(stripped-ooo ...) 772 | (stx-map (compose strip-loc stx-car stx-cdr) 773 | #'([name (... ...)] ...))]) 774 | #'(list 775 | @defform[(stripped-name stripped-ooo)]{ 776 | Overloaded version of @|prefixed| from 777 | @racketmodname[typed/racket] (not implemented for the 778 | @racketmodname[type-expander] library yet, just throws an 779 | error).} 780 | ...))])) 781 | 782 | @ovl-todo[ 783 | ;; TODO: add all-defined-out in prims.rkt 784 | ;; top-interaction.rkt 785 | ;; case-lambda.rkt 786 | pcase-lambda: 787 | ;; (submod "prims-contract.rkt" forms) 788 | require/opaque-type 789 | ;require-typed-struct-legacy 790 | require-typed-struct 791 | ;require/typed-legacy 792 | require/typed 793 | require/typed/provide 794 | require-typed-struct/provide 795 | ;cast 796 | define-predicate 797 | ;; prims.rkt 798 | define-type-alias 799 | define-new-subtype 800 | define-typed-struct 801 | define-typed-struct/exec 802 | define-struct: 803 | define-struct 804 | struct: 805 | λ: 806 | lambda: 807 | letrec 808 | letrec-values 809 | let/cc 810 | let/ec 811 | let: 812 | let*: 813 | letrec: 814 | let-values: 815 | letrec-values: 816 | let/cc: 817 | let/ec: 818 | for 819 | for/list 820 | for/vector 821 | for/hash 822 | for/hasheq 823 | for/hasheqv 824 | for/and 825 | for/or 826 | for/sum 827 | for/product 828 | for/lists 829 | for/first 830 | for/last 831 | for/fold 832 | for* 833 | for*/list 834 | for*/lists 835 | for*/vector 836 | for*/hash 837 | for*/hasheq 838 | for*/hasheqv 839 | for*/and 840 | for*/or 841 | for*/sum 842 | for*/product 843 | for*/first 844 | for*/last 845 | for*/fold 846 | for/set 847 | for*/set 848 | do 849 | do: 850 | with-handlers 851 | define-struct/exec:] 852 | 853 | @include-section{deprecated-colon.scrbl} 854 | 855 | @include-section{contracts-to-types.scrbl} -------------------------------------------------------------------------------- /type-expander.hl.rkt: -------------------------------------------------------------------------------- 1 | #lang hyper-literate racket/base #:no-require-lang 2 | @; The #:no-require-lang above is needed because type-expander requires 3 | @; from 'main some identifiers (e.g. λ) which conflict with the re-required 4 | @; racket/base. With this option, we loose arrows in DrRacket for the 5 | @; built-ins in this file, and have otherwise no adverse effects. 6 | @(require scribble-enhanced/doc) 7 | @doc-lib-setup 8 | 9 | @(module orig-ids racket/base 10 | (require scribble/manual 11 | (for-label typed/racket/base)) 12 | (provide (all-defined-out)) 13 | (define orig:: (racket :)) 14 | (define orig:let (racket let)) 15 | (define orig:→AnyBoolean:Integer (racket (→ Any Boolean : Integer)))) 16 | @(require 'orig-ids) 17 | 18 | @(unless-preexpanding 19 | (require racket/require 20 | (for-label (submod "..") 21 | (only-in (submod ".." main) colon) 22 | (subtract-in typed/racket/base (submod "..")) 23 | (subtract-in racket typed/racket/base (submod "..")) 24 | racket/require-syntax 25 | racket/provide-syntax 26 | typed/racket/unsafe 27 | racket/format 28 | racket/syntax 29 | syntax/stx 30 | syntax/parse 31 | syntax/parse/experimental/template 32 | syntax/id-table 33 | auto-syntax-e 34 | #;(subtract-in typed-racket/base-env/annotate-classes 35 | (submod ".."))))) 36 | 37 | @title[#:style manual-doc-style 38 | #:tag "ty-xp-impl" 39 | #:tag-prefix "type-expander/ty-xp-impl" 40 | ]{Implementation of the type expander library} 41 | 42 | @(chunks-toc-prefix 43 | '("(lib type-expander/scribblings/type-expander-implementation.scrbl)" 44 | "type-expander/ty-xp-impl")) 45 | 46 | This document describes the implementation of the 47 | @racketmodname[type-expander] library, using literate 48 | programming. For the library's documentation, see the 49 | @other-doc['(lib "type-expander/scribblings/type-expander.scrbl")] 50 | document instead. 51 | 52 | @section{Introduction} 53 | 54 | Extensible types would be a nice feature for typed/racket. Unlike 55 | @racket[require] and @racket[provide], which come with 56 | @tc[define-require-syntax] and @tc[define-provide-syntax], and unlike 57 | @tc[match], which comes with @tc[define-match-expander], @tc[typed/racket] 58 | doesn't provide a way to define type expanders. The 59 | @racketmodname[type-expander] library extends @racketmodname[typed/racket] 60 | with the ability to define type expanders, i.e. type-level macros. 61 | 62 | The @secref["ty-xp-more" #:tag-prefixes '("type-expander/ty-xp-more")] section 63 | presents a small library of type expanders built upon the mechanism implemented 64 | here. 65 | 66 | We redefine the forms @tc[:], @tc[define], @tc[lambda] and so on to 67 | equivalents that support type expanders. Type expanders are defined via the 68 | @tc[define-type-expander] macro. Ideally, this would be handled directly by 69 | @tc[typed/racket], which would directly expand uses of type expanders. 70 | 71 | @(table-of-contents) 72 | 73 | @section{Expansion model for type expanders} 74 | 75 | Type expanders are expanded similarly to macros, with two minor differences: 76 | @itemlist[ 77 | @item{A form whose first element is a type expander, e.g. 78 | @racket[(F . args₁)], can expand to the identifier of another type expander 79 | @racket[G]. If the form itself appears as the first element of an outer form, 80 | e.g. @racket[((F . args₁) . args₂)], the first expansion step will result in 81 | @racket[(G . args₂)]. The official macro expander for Racket would then expand 82 | @racket[G] on its own, as an 83 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro}, without 84 | passing the @racket[args₂] to it. In contrast, the type expander will expand 85 | the whole @racket[(G . args₂)] form, letting @racket[G] manipulate the 86 | @racket[args₂] arguments.} 87 | @item{It is possible to write anonymous macros, 88 | 89 | The @racket[Λ] form can be used to create anonymous type expanders. Anonymous 90 | type expanders are to type expanders what anonymous functions are to function 91 | definitions. The following table presents the expression-level and type-level 92 | function and macro forms. Note that @racket[Let] serves as a type-level 93 | equivalent to both @racket[let] and @racket[let-syntax], as anonymous macros 94 | can be used in conjunction with @racket[Let] to obtain the equivalent of 95 | @racket[let-syntax]. 96 | 97 | @tabular[#:style 'boxed 98 | #:sep (hspace 1) 99 | #:column-properties '((right-border right) left) 100 | #:row-properties '((bottom-border baseline) (baseline)) 101 | (list (list "" 102 | @bold{Definitions} 103 | @bold{Local binding} 104 | @bold{Anonymous functions}) 105 | (list @bold{Functions} 106 | @racket[define] 107 | @racket[let] 108 | @racket[λ]) 109 | (list @bold{Macros} 110 | @racket[define-syntax] 111 | @racket[let-syntax] 112 | @emph{N/A}) 113 | (list @bold{Type‑level functions@superscript{a}} 114 | @racket[define-type] 115 | @racket[Let] 116 | @racket[∀]) 117 | (list @bold{Type‑level macros} 118 | @racket[define-type-expander] 119 | @racket[Let] 120 | @racket[Λ]))] 121 | 122 | @superscript{a}: The type-level functions are simple substitution functions, 123 | and cannot perform any kind of computation. They are, in a sense, closer to 124 | pattern macros defined with @racket[define-syntax-rule] than to actual 125 | functions.}] 126 | 127 | Combined, these features allow some form of "curried" application of type 128 | expanders: The @racket[F] type expander could expand to an anonymous 129 | @racket[Λ] type expander which captures the @racket[args₁] arguments. In the 130 | second expansion step, the @racket[Λ] anonymous type expander would then 131 | consume the @racket[args₂] arguments, allowing @racket[F] to effectively 132 | rewrite the two nested forms, instead of being constrained to the innermost 133 | form. 134 | 135 | @subsection{Comparison with TeX's macro expansion model} 136 | 137 | For long-time TeX or LaTeX users, this may raise some concerns. TeX programs 138 | are parsed as a stream of tokens. A TeX commands is a macro. When a TeX macro 139 | occurs in the stream of tokens, it takes its arguments by consuming a certain 140 | number of tokens following it. After consuming these arguments, a TeX macro 141 | may expand to another TeX macro, which in turn consumes more arguments. This 142 | feature is commonly used in TeX to implement macros which consume a variable 143 | number arguments: the macro will initially consume a single argument. 144 | Depending on the value of that argument, it will then expand to a macro taking 145 | @racket[_n] arguments, or another macro taking @racket[_m] arguments. This 146 | pattern, omnipresent in any sufficiently large TeX program, opens the door to 147 | an undesirable class of bugs: when a TeX macro invocation appears in the 148 | source code, it is not clear syntactically how many arguments it will 149 | eventually consume. An incorrect parameter value can easily cause it to 150 | consume more arguments than expected. This makes it possible for the macro to 151 | consume the end markers of surrounding environments, for example in the code: 152 | 153 | @verbatim|{ 154 | \begin{someEnvironment} 155 | \someMacro{arg1}{arg2} 156 | \end{someEnvironment} 157 | }| 158 | 159 | the @literal|{someMacro}| command may actually expect three arguments, in 160 | which case it will consume the @literal|{\end}| token, but leave the 161 | @literal|{{someEnvironment}}| token in the stream. This will result in a badly 162 | broken TeX program, which will most likely throw an error complaining that the 163 | environment @literal|{\begin{someEnvironment}}| is not properly closed. The 164 | error may however occur in a completely different location, and may easily 165 | cause a cascade of errors (the missing @literal|{\end{someEnvironment}}| may 166 | cause later TeX commands to be interpreted in a different way, causing them to 167 | misinterpret their arguments, which in turn may cause further errors. The end 168 | result is a series of mysterious error messages somewhat unrelated to the 169 | initial problem. 170 | 171 | This problem with TeX macros can be summed up as follows: the number of tokens 172 | following a TeX macro invocation that will be consumed by the macro is 173 | unbounded, and cannot be easily guessed by looking at the raw source code, 174 | despite the presence of programmer-friendly looking syntactic hints, like 175 | wrapping arguments with @literal|{{…}}|. 176 | 177 | We argue that the expansion model for type expanders is less prone to this 178 | class of problems, for several reasons: 179 | @itemlist[ 180 | @item{Firstly, macros can only consume outer forms if they appear as the 181 | leftmost leaf of the outer form, i.e. while the @racket[F] macro in the 182 | expression 183 | 184 | @racketblock[((F . args₁) . args₂)] 185 | 186 | may access the @racket[args₂] arguments, it will be constrained within the 187 | @racket[(F . args₁)] in the following code: 188 | 189 | @racketblock[(H leading-args₂ (F . args₁) . more-args₂)] 190 | 191 | The first case occurs much more rarely than the second, so is less likely to 192 | happen} 193 | @item{Secondly, all TeX macros will consume an arbitrary number of arguments 194 | in a linear fashion until the end of the enclosing group or a paragraph 195 | separation. In contrast, most type expanders will consume all the arguments 196 | within their enclosing application form, and no more. ``Curried'' type 197 | expanders, which expand to a lone macro identifier, will likely only represent 198 | a small subset of all type expanders. For comparison, consider the following 199 | TeX code: 200 | 201 | @verbatim|{\CommandOne{argA}\CommandTwo{argB}}| 202 | 203 | The @literal|{\CommandOne}| TeX macro might consume zero, one, two three or 204 | more arguments. If it consumes zero arguments, @literal|{{argA}}| will not be 205 | interpreted as an argument, but instead will represent a scoped expression, 206 | similar to @racket[(let () argA)]. If @literal|{\CommandOne}| consumes two or 207 | more arguments, @literal|{\CommandTwo}| will be passed as an argument, 208 | unevaluated, and may be discarded or applied to other arguments than the 209 | seemingly obvious @literal|{{argB}}| argument. The TeX code above could 210 | therefore be equivalent to any the following Racket programs: 211 | 212 | @racketblock[ 213 | (CommandOne) 214 | (let () argA) 215 | (CommandTwo) 216 | (let () argB)] 217 | 218 | @racketblock[ 219 | (CommandOne argA) 220 | (CommandTwo) 221 | (let () argB)] 222 | 223 | @racketblock[ 224 | (CommandOne) 225 | (let () argA) 226 | (CommandTwo argB)] 227 | 228 | @racketblock[ 229 | (CommandOne argA) 230 | (CommandTwo argB)] 231 | 232 | @racketblock[ 233 | (CommandOne argA CommandTwo) 234 | (let () argB)] 235 | 236 | @racketblock[ 237 | (CommandOne argA CommandTwo argB)] 238 | 239 | In contrast, the obvious interpretation at a first glance of the TeX program 240 | would be written as follows in Racket: 241 | 242 | @racketblock[ 243 | (CommandOne argA) 244 | (CommandTwo argB)] 245 | 246 | If these appear as ``arguments'' of a larger expression, then their meaning 247 | is unambiguous (unless the larger expression is itself a macro): 248 | 249 | @racketblock[ 250 | (+ (CommandOne argA) 251 | (CommandTwo argB))] 252 | 253 | If however the @racket[(CommandOne argA)] is the first element in its form, 254 | then, if it is a curried macro, it may consume the the 255 | @racket[(CommandTwo argB)] form too: 256 | 257 | 258 | @racketblock[ 259 | ((CommandOne argA) 260 | (CommandTwo argB))] 261 | 262 | As stated earlier, this case will likely be less common, and it is clearer 263 | that the intent of the programmer to pass @racket[(CommandTwo argB)] as 264 | arguments to the result of @racket[(CommandOne argA)], either as a macro 265 | application or as a regular run-time function application.} 266 | @item{Finally, Racket macros (and type expanders) usually perform a somewhat 267 | thorough check of their arguments, using @racket[syntax-parse] or 268 | @racket[syntax-case] patterns. Arguments to macros and type expanders which do 269 | not have the correct shape will trigger an error early, thereby limiting the 270 | risk of causing errors in cascade.}] 271 | 272 | @subsection{Interactions between type expanders and scopes} 273 | 274 | Our expansion model for type expanders therefore allows a type expander to 275 | escape the scope in which it was defined before it is actually expanded. For 276 | example, the following type: 277 | 278 | @RACKETBLOCK[ 279 | (Let ([A Number]) 280 | ((Let ([F (Λ (self T) 281 | #`(Pairof #,(datum->syntax #'self 'A) 282 | T))]) 283 | (Let ([A String]) 284 | F)) 285 | A))] 286 | 287 | first expands to: 288 | 289 | @RACKETBLOCK[ 290 | (F 291 | A)] 292 | 293 | and then expands to: 294 | 295 | @RACKETBLOCK[ 296 | (Pairof String A)] 297 | 298 | and finally expands to: 299 | 300 | @RACKETBLOCK[ 301 | (Pairof String A)] 302 | 303 | Effectively, @racket[F] captures the scope where its name appears (inside all 304 | three @racket[Let] forms), but is expanded in a different context (outside of 305 | the two innermost @racket[Let] forms). 306 | 307 | Using Matthew Flatt's notation to indicate the scopes present on an 308 | identifier, we can more explicitly show the expansion steps: 309 | 310 | @RACKETBLOCK[ 311 | (Let ([A Number]) 312 | ((Let ([F (Λ (self T) 313 | #`(Pairof #,(datum->syntax #'self 'A) 314 | T))]) 315 | (Let ([A String]) 316 | F)) 317 | A))] 318 | 319 | The first @racket[Let] form annotates the identifier it binds with a fresh 320 | scope, numbered @racket[1] here, and adds this scope to all identifiers within 321 | its body. It stores the binding in the @racket[(tl-redirections)] binding 322 | table, as shown by the comment above the code 323 | 324 | @RACKETBLOCK[ 325 | (code:comment "A¹ := Number") 326 | ((Let¹ ([F¹ (Λ¹ (self¹ T¹) 327 | #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹) 328 | T¹))]) 329 | (Let¹ ([A¹ String¹]) 330 | F¹)) 331 | A¹)] 332 | 333 | The second @racket[Let] form then binds the @racket[F] identifier, adding a 334 | fresh scope as before: 335 | 336 | @RACKETBLOCK[ 337 | (code:comment "A¹ := Number") 338 | (code:comment "F¹² := (Λ¹ (self¹ T¹)") 339 | (code:comment " #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹)") 340 | (code:comment " T¹))") 341 | ((Let¹² ([A¹² String¹²]) 342 | F¹²) 343 | A¹)] 344 | 345 | The third @racket[Let] form then binds @racket[A] within its body, leaving the 346 | outer @racket[A] unchanged: 347 | 348 | @RACKETBLOCK[ 349 | (code:comment "A¹ := Number") 350 | (code:comment "F¹² := (Λ¹ (self¹ T¹)") 351 | (code:comment " #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹)") 352 | (code:comment " T¹))") 353 | (code:comment "A¹²³ := String¹²") 354 | (F¹²³ 355 | A¹)] 356 | 357 | The @racket[F¹²³] macro is then expanded, passing as an argument the syntax 358 | object @racket[#'(F¹²³ A¹)]. A fresh scope is added to the identifiers 359 | generated by the macro, in order to enforce macro hygiene. The @racket[A¹] 360 | identifier is passed as an input to the macro, so it is left unchanged, and 361 | @racket[A¹²³] is derived from @racket[F¹²³], via @racket[datum->syntax], and 362 | therefore has the same scopes (@racket[F¹²³] is also a macro input, so it is 363 | not tagged with the fresh scope). The @racket[Pairof¹] identifier, generated by 364 | the macro, is however flagged with the fresh scope @racket[4]. The result of 365 | the application of @racket[F] to this syntax object is: 366 | 367 | @RACKETBLOCK[ 368 | (code:comment "A¹ := Number") 369 | (code:comment "F¹² := (Λ¹ (self¹ T¹)") 370 | (code:comment " #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹)") 371 | (code:comment " T¹))") 372 | (code:comment "A¹²³ := String¹²") 373 | (Pairof¹⁴ A¹²³ A¹)] 374 | 375 | The @racket[Pairof¹⁴] type is resolved to the primitive type constructor 376 | @racket[Pairof]: 377 | 378 | @RACKETBLOCK[ 379 | (code:comment "A¹ := Number") 380 | (code:comment "F¹² := (Λ¹ (self¹ T¹)") 381 | (code:comment " #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹)") 382 | (code:comment " T¹))") 383 | (code:comment "A¹²³ := String¹²") 384 | (Pairof A¹²³ A¹)] 385 | 386 | The type @racket[A¹²³] is then resolved to @racket[String¹²], which in turn is 387 | resolved to the @racket[String] built-in type: 388 | 389 | @RACKETBLOCK[ 390 | (code:comment "A¹ := Number") 391 | (code:comment "F¹² := (Λ¹ (self¹ T¹)") 392 | (code:comment " #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹)") 393 | (code:comment " T¹))") 394 | (code:comment "A¹²³ := String¹²") 395 | (Pairof String A¹)] 396 | 397 | And the type @racket[A¹] is resolved to @racket[Number]: 398 | 399 | @RACKETBLOCK[ 400 | (code:comment "A¹ := Number") 401 | (code:comment "F¹² := (Λ¹ (self¹ T¹)") 402 | (code:comment " #`(Pairof¹ #,(datum->syntax¹ #'self¹ 'A¹)") 403 | (code:comment " T¹))") 404 | (code:comment "A¹²³ := String¹²") 405 | (Pairof String Number)] 406 | 407 | The @racket[syntax-local-value] function does not support querying the 408 | transformer binding of identifiers outside of the lexical scope in which they 409 | are bound. In our case, however, we need to access the transformer binding of 410 | @racket[F¹²³] outside of the scope of the @racket[Let] binding it, and 411 | similarly for @racket[A¹²³]. 412 | 413 | @section{The @racket[prop:type-expander] structure type property} 414 | 415 | Type expanders are identified by the @tc[prop:type-expander] 416 | @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{structure type 417 | property}. Structure type properties allow the same identifier to act as a 418 | rename transformer, a match expander and a type expander, for example. Such an 419 | identifier would have to implement the @tc[prop:rename-transformer], 420 | @tc[prop:match-expander] and @tc[prop:type-expander] properties, respectively. 421 | 422 | @chunk[ 423 | (define-values (prop:type-expander 424 | has-prop:type-expander? 425 | get-prop:type-expander-value) 426 | (make-struct-type-property 'type-expander prop-guard))] 427 | 428 | The value of the @tc[prop:type-expander] property should either be a 429 | transformer procedure of one or two arguments which will be called when 430 | expanding the type, or the index of a field containing such a procedure. 431 | 432 | @chunk[ 433 | (define (prop-guard val struct-type-info-list) 434 | (cond 435 | 436 | ))] 437 | 438 | If the value is a field index, it should be within bounds. The 439 | @tc[make-struct-field-accessor] function performs this check, and also returns 440 | an accessor. The accessor expects an instance of the struct, and returns the 441 | field's value. 442 | 443 | @chunk[ 444 | [(exact-nonnegative-integer? val) 445 | (let* ([make-struct-accessor (cadddr struct-type-info-list)] 446 | [accessor (make-struct-field-accessor make-struct-accessor val)]) 447 | (λ (instance) 448 | (let ([type-expander (accessor instance)]) 449 | )))]] 450 | 451 | The expander procedure will take one argument: the piece of syntax 452 | corresponding to the use of the expander. If the property's value is a 453 | procedure, we therefore check that its arity includes 1. 454 | 455 | @chunk[ 456 | (cond 457 | [(and (procedure? type-expander) 458 | (arity-includes? (procedure-arity type-expander) 2)) 459 | (curry type-expander instance)] 460 | [(and (procedure? type-expander) 461 | (arity-includes? (procedure-arity type-expander) 1)) 462 | type-expander] 463 | [else 464 | (raise-argument-error 'prop:type-expander-guard 465 | (~a "the value of the " val "-th field should" 466 | " be a procedure whose arity includes 1 or" 467 | " 2") 468 | type-expander)])] 469 | 470 | In the first case, when the property value is a field index, we return an 471 | accessor function. The accessor function expects a struct instance, performs 472 | some checks and returns the actual type expander procedure. 473 | 474 | When the property's value is directly a type expander procedure, we follow the 475 | same convention. We therefore return a function which, given a struct 476 | instance, returns the type expander procedure (ignoring the @racket[_] 477 | argument). 478 | 479 | @chunk[ 480 | [(procedure? val) 481 | (cond 482 | [(arity-includes? (procedure-arity val) 2) 483 | (λ (s) (curry val s))] 484 | [(arity-includes? (procedure-arity val) 1) 485 | (λ (_) val)] 486 | [else 487 | (raise-argument-error 'prop:type-expander-guard 488 | "a procedure whose arity includes 1 or 2" 489 | val)])]] 490 | 491 | When the value of the @racket[prop:type-expander] property is neither a 492 | positive field index nor a procedure, an error is raised: 493 | 494 | @chunk[ 495 | [else 496 | (raise-argument-error 497 | 'prop:type-expander-guard 498 | (~a "a procedure whose arity includes 1 or 2, or an exact " 499 | "non-negative integer designating a field index within " 500 | "the structure that should contain a procedure whose " 501 | "arity includes 1 or 2.") 502 | val)]] 503 | 504 | @subsection{The @racket[type-expander] struct} 505 | 506 | We make a simple struct that implements @tc[prop:type-expander] and nothing 507 | else. It has a single field, @racket[expander-proc], which contains the type 508 | expander transformer procedure. 509 | 510 | @chunk[ 511 | (struct type-expander (expander-proc) #:transparent 512 | #:extra-constructor-name make-type-expander 513 | #:property prop:type-expander (struct-field-index expander-proc))] 514 | 515 | @section{Associating type expanders to identifiers} 516 | 517 | @subsection{The @racket[type-expander] syntax class} 518 | 519 | The @tc[type-expander] syntax class recognises identifiers 520 | which are bound to type expanders. These fall into three cases: 521 | @itemlist[ 522 | @item{The identifier's @racket[syntax-local-value] is an instance of a struct 523 | implementing @racket[prop:type-expander]} 524 | @item{The identifier has been bound by a type-level local binding form like 525 | @racket[Let] or @racket[∀], and therefore are registered in the 526 | @racket[(tl-redirections)] binding table.} 527 | @item{The identifier has been patched via @racket[patch-type-expander], i.e. 528 | a type expander has been globally attached to an existing identifier, in which 529 | case the type expander is stored within the @racket[patched] free identifier 530 | table.}] 531 | 532 | @chunk[ 533 | (define-syntax-class type-expander 534 | (pattern local-expander:id 535 | #:when (let ([b (binding-table-find-best (tl-redirections) 536 | #'local-expander 537 | #f)]) 538 | (and b (has-prop:type-expander? b))) 539 | #:with code #'local-expander) 540 | (pattern (~var expander 541 | (static has-prop:type-expander? "a type expander")) 542 | #:when (not (binding-table-find-best (tl-redirections) 543 | #'expander 544 | #f)) 545 | #:with code #'expander) 546 | (pattern patched-expander:id 547 | #:when (let ([p (free-id-table-ref patched 548 | #'patched-expander 549 | #f)]) 550 | (and p (has-prop:type-expander? p))) 551 | #:when (not (binding-table-find-best (tl-redirections) 552 | #'expander 553 | #f)) 554 | #:with code #'patched-expander))] 555 | 556 | We also define a syntax class which matches types. Since types can bear many 557 | complex cases, and can call type expanders which may accept arbitrary syntax, 558 | we simply define the @tc[type] syntax class as @tc[expr]. Invalid syntax will 559 | be eventually caught while expanding the type, and doing a thorough check 560 | before any processing would only make the type expander slower, with little 561 | actual benefits. The @tc[type] syntax class is however used in syntax patterns 562 | as a form of documentation, to clarify the distinction between types and 563 | run-time or compile-time expressions. 564 | 565 | @CHUNK[ 566 | (define-syntax-class type 567 | (pattern :expr))] 568 | 569 | @chunk[ 570 | (define stx-type/c syntax?)] 571 | 572 | Finally, we define a convenience syntax class which expands the matched type: 573 | 574 | @chunk[ 575 | (define-syntax-class type-expand! 576 | #:attributes (expanded) 577 | (pattern t:expr 578 | #:with expanded (expand-type #'t #f)))] 579 | 580 | @subsection{Calling type expanders} 581 | 582 | The @tc[apply-type-expander] function applies the syntax expander transformer 583 | function associated to @tc[type-expander-id]. It passes @tc[stx] as the single 584 | argument to the transformer function. Usually, @tc[stx] will be the syntax 585 | used to call the type expander, like @tc[#'(te arg ...)] or just @tc[#'te] if 586 | the type expander is not in the first position of a form. 587 | 588 | The identifier @tc[type-expander-id] should be bound to a type expander, in 589 | one of the three possible ways described above. 590 | 591 | @chunk[ 592 | (define/contract (apply-type-expander type-expander-id stx) 593 | (-> identifier? syntax? syntax?) 594 | (let ([val (or (binding-table-find-best (tl-redirections) 595 | type-expander-id 596 | #f) 597 | (let ([slv (syntax-local-value type-expander-id 598 | (λ () #f))]) 599 | (and (has-prop:type-expander? slv) slv)) 600 | (free-id-table-ref patched type-expander-id #f))] 601 | [ctxx (make-syntax-introducer)]) 602 | 603 | (ctxx (((get-prop:type-expander-value val) val) (ctxx stx)))))] 604 | 605 | The @racket[apply-type-expander] function checks that its 606 | @racket[type-expander-id] argument is indeed a type expander before attempting 607 | to apply it: 608 | 609 | @chunk[ 610 | (unless val 611 | (raise-syntax-error 'apply-type-expander 612 | (format "Can't apply ~a, it is not a type expander" 613 | type-expander-id) 614 | stx 615 | type-expander-id))] 616 | 617 | @subsection{Associating type expanders to already existing identifiers} 618 | 619 | As explained above, existing identifiers which are provided by other libraries 620 | can be ``patched'' so that they behave like type expanders, using a global 621 | table associating existing identifiers to the corresponding expander code: 622 | 623 | @chunk[ 624 | (define patched (make-free-id-table))] 625 | 626 | @CHUNK[ 627 | (define-syntax patch-type-expander 628 | (syntax-parser 629 | [(_ id:id expander-expr:expr) 630 | #`(begin 631 | (begin-for-syntax 632 | (free-id-table-set! patched 633 | #'id 634 | (type-expander #,(syntax/loc this-syntax 635 | expander-expr)))))]))] 636 | 637 | @subsection{Defining new type expanders} 638 | 639 | The @tc[define-type-expander] macro binds @tc[_name] to a 640 | type expander which uses @tc[(λ (_arg) . _body)] as the 641 | transformer procedure. To achieve this, we create a 642 | transformer binding (with @tc[define-syntax]), from 643 | @tc[_name] to an instance of the @tc[type-expander] 644 | structure. 645 | 646 | @CHUNK[ 647 | (define-syntax define-type-expander 648 | (syntax-parser 649 | [(_ (name:id arg:id) . body) 650 | #`(define-syntax name 651 | (type-expander #,(syntax/loc this-syntax (λ (arg) . body))))] 652 | [(_ name:id fn:expr) 653 | #`(define-syntax name 654 | (type-expander #,(syntax/loc this-syntax fn)))]))] 655 | 656 | @subsection[#:tag "shadow"]{Locally binding type expanders} 657 | 658 | Some features of the type expander need to locally bind new type expanders: 659 | 660 | @itemlist[ 661 | @item{The @racket[(Let ([_id _expr] …) . _body)] special form binds the 662 | identifiers @racket[_id …] to the type expanders @racket[_expr …] in its 663 | @racket[_body].} 664 | @item{When expanding the body of a @racket[(∀ (Tᵢ …) body)] form, the 665 | @racket[Tᵢ] bound by the @racket[∀] may shadow some type expanders with the 666 | same name. If the @racket[∀] form is directly applied to arguments, each 667 | @racket[Tᵢ] is instead bound to the corresponding argument.} 668 | @item{When expanding the body of a @racket[(Rec T body)] form, the @racket[T] 669 | bound by the @racket[Rec] may shadow a type expander with the same name.}] 670 | 671 | We use @racket[with-bindings] (defined in another file) to achieve this. The 672 | code 673 | 674 | @racketblock[(with-bindings [_bound-ids _transformer-values] 675 | _rebind-stx 676 | _transformer-body)] 677 | 678 | evaluates @racket[_transformer-body] in the transformer environment. It 679 | creates a fresh scope, which it applies to the @racket[_bound-ids] and the 680 | @racket[_rebind-stx]. It associates each modified @racket[_bound-id] with the 681 | corresponding @racket[_transformer-value] in the @racket[(tl-redirections)] 682 | binding table. The @racket[with-bindings] form does not mutate the syntax 683 | objects, instead it shadows the syntax pattern variables mentioned in 684 | @racket[_bound-ids] and @racket[_rebind-stx] with versions pointing to the 685 | same syntax objects, but with the fresh scope flipped on them. 686 | 687 | The code 688 | 689 | @racketblock[(with-rec-bindings [_bound-ids _generate-transformer-values _rhs] 690 | _rebind-stx 691 | _transformer-body)] 692 | 693 | works in the same way, but it also flips the fresh scope on each element of 694 | @racket[_rhs]. The @racket[_generate-transformer-values] is expected to be a 695 | transformer expression which, given an element of @racket[_rhs] with the 696 | flipped scope, produces the transformer value to bind to the corresponding 697 | @racket[_bound-id]. 698 | 699 | 700 | The implementation of @racket[with-bindings] unfortunately does not play well 701 | with @racket[syntax-local-value], so the binding table has to be queried 702 | directly instead of using @racket[syntax-local-value]. To our knowledge, the 703 | only ways to make new bindings recognised by @racket[syntax-local-value] are: 704 | @itemlist[ 705 | @item{To expand to a @racket[define-syntax] form, followed with a macro 706 | performing the remaining work} 707 | @item{Equivalently, to expand to a @racket[let-syntax] form, whose body is a 708 | macro performing the remaining work} 709 | @item{To call @racket[local-expand] with an internal definition context which 710 | contains the desired bindings} 711 | @item{To explicitly call @racket[syntax-local-value] with an internal 712 | definition context argument}] 713 | 714 | It is not practical in our case to use the first solution involving 715 | @racket[define-syntax], as the type expander may be called while expanding an 716 | expression (e.g. @racket[ann]). The next two solutions assume that 717 | @racket[syntax-local-value] will be called in a well-scoped fashion (in the 718 | sense of the official expander): in the second solution, 719 | @racket[syntax-local-value] must be called by expansion-time code located 720 | within the scope of the @racket[let-syntax] form, and in the third solution, 721 | @racket[syntax-local-value] must be called within the dynamic extent of 722 | @racket[local-expand]. The last solution works, but requires that the user 723 | explicitly passes the appropriate internal definition context. 724 | 725 | The second and third solutions cannot be applied in our case, because type 726 | expanders can be expanded outside of the scope in which they were defined and 727 | used, as explained the 728 | @secref["Interactions_between_type_expanders_and_scopes"] section. 729 | 730 | The current version of the type expander does not support a reliable 731 | alternative to @racket[syntax-local-value] which takes into account local 732 | binding forms for types (@racket[Let], @racket[∀] and @racket[Rec]), but one 733 | could be implemented, either by using some tricks to make the first solution 734 | work, or by providing an equivalent to @racket[syntax-local-value] which 735 | consults the @racket[(tl-redirections)] binding table. 736 | 737 | @section{Expanding types} 738 | 739 | The @tc[expand-type] function fully expands the type 740 | @tc[stx]. As explained in 741 | @secref["shadow"], shadowing would be better handled using 742 | scopes. The @tc[expand-type] function starts by defining 743 | some syntax classes, then parses @tc[stx], which can fall in 744 | many different cases. 745 | 746 | @CHUNK[ 747 | (define (expand-type stx [applicable? #f]) 748 | (start-tl-redirections 749 | 750 | (define (expand-type-process stx first-pass?) 751 | 752 | ((λ (result) ) 753 | (parameterize () 754 | 755 | (syntax-parse stx 756 | 757 | 758 | 759 | 760 | 761 | 762 | 763 | 764 | 765 | 766 | 767 | 768 | 769 | 770 | (code:comment "Must be after other special application cases") 771 | 772 | 773 | )))) 774 | (expand-type-process stx #t)))] 775 | 776 | @subsection{Cases handled by @racket[expand-type]} 777 | 778 | The cases described below which expand a use of a type expander re-expand the 779 | result, by calling @tc[expand-type] once more. This process is repeated until 780 | no more expansion can be performed. This allows type expanders to produce 781 | calls to other type expanders, exactly like macros can produce calls to other 782 | macros. 783 | 784 | We distinguish the expansion of types which will appear as the first element 785 | of their parent form from types which will appear in other places. When the 786 | @racket[applicable?] argument to @racket[expand-type] is @racket[#true], it 787 | indicates that the current type, once expanded, will occur as the first 788 | element of its enclosing form. If the expanded type is the name of a type 789 | expander, or a @racket[∀] or @racket[Λ] form, it will be directly applied to 790 | the given arguments by the type expander. When @racket[applicable?] is 791 | @racket[#false], it indicates that the current type, once expanded, will 792 | @emph{not} appear as the first element of its enclosing form (it will appear 793 | in another position, or it is at the top of the syntax tree representing the 794 | type). 795 | 796 | When @racket[applicable?] is @racket[#true], if the type is the name of a type 797 | expander, or a @racket[∀] or @racket[Λ] form, it is not expanded immediately. 798 | Instead, the outer form will expand it with the arguments. Otherwise, these 799 | forms are expanded without arguments, like 800 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macros} would be. 801 | 802 | @subsection{Applying type expanders} 803 | 804 | When a type expander is found in a non-applicable position, it is called, 805 | passing the identifier itself to the expander. An 806 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro} would be 807 | called in the same way. 808 | 809 | @CHUNK[ 810 | [expander:type-expander 811 | #:when (not applicable?) 812 | (rule id-expander/not-applicable 813 | (let ([ctxx (make-syntax-introducer)]) 814 | (expand-type (ctxx (apply-type-expander #'expander.code 815 | (ctxx #'expander))) 816 | applicable?)))]] 817 | 818 | When a type expander is found in an applicable position, it is returned 819 | without modification, so that the containing application form may expand it 820 | with arguments. When the expander @racket[e] appears as @racket[(e . args)], 821 | it is applicable. It is also applicable when it appears as 822 | @racket[((Let (bindings…) e) . args)], for example, because @racket[Let] 823 | propagates its @racket[applicable?] status. 824 | 825 | @CHUNK[ 826 | [expander:type-expander 827 | #:when applicable? 828 | (rule id-expander/applicable 829 | #'expander)]] 830 | 831 | When a form contains a type expander in its first element, the type expander 832 | is called. The result is re-expanded, so that a type expander can expand to a 833 | use of another type expander. 834 | 835 | @CHUNK[ 836 | [(~and expander-call-stx (expander:type-expander . _)) 837 | (rule app-expander 838 | (let ([ctxx (make-syntax-introducer)]) 839 | (expand-type (ctxx (apply-type-expander #'expander.code 840 | (ctxx #'expander-call-stx))) 841 | applicable?)))]] 842 | 843 | When a form of the shape @racket[(_f . _args)] is encountered, and the 844 | @racket[_f] element is not a type expander, the @racket[_f] form is expanded, 845 | and the whole form (with @racket[_f] replaced by its expansion) is expanded a 846 | second time. The @racket[applicable?] parameter is set to @racket[#true] while 847 | expanding @racket[_f], so that if @racket[_f] produces a type expander (e.g. 848 | @racket[_f] has the shape @racket[(Let (…) _some-type-expander)]), the type 849 | expander can be applied to the @racket[_args] arguments. 850 | 851 | @CHUNK[ 852 | [(~and whole (f . args)) 853 | #:when first-pass? 854 | (rule app-other 855 | (expand-type-process 856 | (datum->syntax #'whole 857 | (cons (expand-type #'f #true) #'args) 858 | #'whole 859 | #'whole) 860 | #f))]] 861 | 862 | @subsubsection{Polymorphic types with @racket[∀]} 863 | 864 | When the @tc[∀] or @tc[All] special forms from @racketmodname[typed/racket] 865 | are used, the bound type variables may shadow some type expanders. The type 866 | expanders used in the body @tc[T] which have the same identifier as a bound 867 | variable will be affected by this (they will not act as a type-expander 868 | anymore). The body of the @tc[∀] or @tc[All] form is expanded with the 869 | modified environment. The result is wrapped again with 870 | @tc[(∀ (TVar …) expanded-T)], in order to conserve the behaviour from 871 | @racketmodname[typed/racket]'s @tc[∀]. 872 | 873 | @CHUNK[ 874 | [({~and ∀ {~literal ∀}} (tvar:id …) T:type) 875 | #:when (not applicable?) 876 | (rule just-∀/not-applicable 877 | (with-syntax ([(tvar-vars-only …) (remove-ddd #'(tvar …))]) 878 | (with-bindings [(tvar-vars-only …) (stx-map 879 | #'(tvar-vars-only …))] 880 | (T tvar …) 881 | #`(∀ (tvar …) 882 | #,(expand-type #'T #f)))))]] 883 | 884 | Where @racket[] is used to bind the type variables @racket[tvarᵢ] to 885 | @racket[(No-Expand tvarᵢ)], so that their occurrences are left intact by the 886 | type expander: 887 | 888 | @CHUNK[ 889 | (λ (__τ) 890 | (make-type-expander 891 | (λ (stx) 892 | (syntax-case stx () 893 | [self (identifier? #'self) #'(No-Expand self)] 894 | [(self . args) #'((No-Expand self) . args)]))))] 895 | 896 | When a @racket[∀] polymorphic type is found in an applicable position, it is 897 | returned without modification, so that the containing application form may 898 | expand it, binding the type parameters to their effective arguments. 899 | 900 | @CHUNK[ 901 | [(~and whole ({~literal ∀} (tvar:id …) T:type)) 902 | #:when applicable? 903 | (rule just-∀/applicable 904 | #'whole)]] 905 | 906 | When a @racket[∀] polymorphic type is immediately applied to arguments, the 907 | type expander attempts to bind the type parameters to the effective arguments. 908 | It currently lacks any support for types under ellipses, and therefore that 909 | case is currently handled by the @racket[] case 910 | described later. 911 | 912 | @chunk[ 913 | [(({~literal ∀} ({~and tvar:id {~not {~literal …}}} …) τ) arg …) 914 | (unless (= (length (syntax->list #'(tvar …))) 915 | (length (syntax->list #'(arg …)))) 916 | ) 917 | (rule app-∀ 918 | (with-bindings [(tvar …) (stx-map (λ (a) (make-type-expander (λ (_) a))) 919 | #'(arg …))] 920 | τ 921 | (expand-type #'τ applicable?)))]] 922 | 923 | If the given number of arguments does not match the expected number of 924 | arguments, an error is raised immediately: 925 | 926 | @chunk[ 927 | (raise-syntax-error 928 | 'type-expander 929 | (format (string-append "Wrong number of arguments to " 930 | "polymorphic type: ~a\n" 931 | " expected: ~a\n" 932 | " given: ~a" 933 | " arguments were...:\n") 934 | (syntax->datum #'f) 935 | (length (syntax->list #'(tvar …))) 936 | (length (syntax->list #'(arg …))) 937 | (string-join 938 | (stx-map (λ (a) 939 | (format "~a" (syntax->datum a))) 940 | #'(arg …)) 941 | "\n")) 942 | #'whole 943 | #'∀ 944 | (syntax->list #'(arg …)))] 945 | 946 | @subsubsection{Recursive types with @racket[Rec]} 947 | 948 | Similarly, the @tc[Rec] special form will cause the bound 949 | variable @tc[R] to shadow type expanders with the same name, 950 | within the extent of the body @tc[T]. The result is wrapped 951 | again with @tc[(Rec R expanded-T)], in order to conserve the 952 | behaviour from @racketmodname[typed/racket]'s @tc[Rec]. 953 | 954 | @CHUNK[ 955 | [((~literal Rec) R:id T:type) 956 | (rule Rec 957 | #`(Rec R #,(with-bindings [R ( #'R)] 958 | T 959 | (expand-type #'T #f))))]] 960 | 961 | @subsubsection{Local bindings with @racket[Let] and @racket[Letrec]} 962 | 963 | The @tc[Let] special form binds the given identifiers to the corresponding 964 | type expanders. We use @racket[with-bindings], as explained above in 965 | @secref["shadow" #:doc '(lib "type-expander/type-expander.hl.rkt")], to bind 966 | the @racket[Vᵢ …] identifiers to their corresponding @racket[Eᵢ] while 967 | expanding @racket[T]. 968 | 969 | @CHUNK[ 970 | [((~commit (~literal Let)) ([Vᵢ:id Eᵢ] …) T:type) 971 | (rule Let 972 | (with-bindings [(Vᵢ …) 973 | (stx-map (λ (Eᵢ) 974 | (make-type-expander 975 | (λ (stx) 976 | (syntax-case stx () 977 | [self (identifier? #'self) Eᵢ] 978 | [(self . argz) #`(#,Eᵢ . argz)])))) 979 | #'(Eᵢ …))] 980 | T 981 | (expand-type #'T applicable?)))]] 982 | 983 | The @tc[Letrec] special form behaves in a similar way, but uses 984 | @racket[with-rec-bindings], so that the right-hand-side expressions 985 | @racket[Eᵢ] appear to be within the scope of all the @racket[Vᵢ] bindings. 986 | 987 | @CHUNK[ 988 | [((~commit (~literal Letrec)) ([Vᵢ:id Eᵢ] …) T:type) 989 | (rule Letrec 990 | (with-rec-bindings [(Vᵢ …) 991 | (λ (Eᵢ) 992 | (make-type-expander 993 | (λ (stx) 994 | (syntax-case stx () 995 | [self (identifier? #'self) Eᵢ] 996 | [(self . args444) #`(#,Eᵢ . args444)])))) 997 | Eᵢ] 998 | T 999 | (expand-type #'T applicable?)))]] 1000 | 1001 | @subsubsection{Anonymous types with @racket[Λ]} 1002 | 1003 | When an anonymous type expander appears as the first element of its enclosing 1004 | form, it is applied to the given arguments. We use the 1005 | @racket[trampoline-eval] function defined in another file, which evaluates the 1006 | given quoted transformer expression, while limiting the issues related to 1007 | scopes. The ``official'' @racket[eval] function from 1008 | @racketmodname[racket/base] removes one of the module scopes which are 1009 | normally present on the expression to evaluate. In our case, we are evaluating 1010 | an anonymous type expander, i.e. a transformer function. When using 1011 | @racket[eval], identifiers generated by the transformer function may not have 1012 | the expected bindings. The alternative @racket[trampoline-eval] seems to solve 1013 | this problem. 1014 | 1015 | The @racket[auto-syntax-case] form is used, so that an anonymous type expander 1016 | @racket[(Λ (_ a b) …)] can either use @racket[a] and @racket[b] as pattern 1017 | variables in quoted syntax objects, or as regular values (i.e 1018 | @racket[syntax->datum] is automatically applied on the syntax pattern 1019 | variables when they are used outside of syntax templates, instead of throwing 1020 | an error). 1021 | 1022 | @chunk[ 1023 | (trampoline-eval 1024 | #'(λ (stx) 1025 | (define ctxx (make-syntax-introducer)) 1026 | (ctxx (auto-syntax-case (ctxx (stx-cdr stx)) () 1027 | [formals (let () . body)]))))] 1028 | 1029 | This case works by locally binding a fresh identifier @racket[tmp] to a type 1030 | expander, and then applying that type expander. It would also be possible to 1031 | immediately invoke the type expander function. 1032 | 1033 | @chunk[ 1034 | [{~and whole (({~literal Λ} formals . body) . __args)} 1035 | ;; TODO: use the same code as for the not-applicable case, to avoid ≠ 1036 | (rule app-Λ 1037 | (with-syntax* ([tmp (gensym '#%Λ-app-)] 1038 | [call-stx #'(tmp . whole)]) 1039 | (with-bindings [tmp (make-type-expander 1040 | )] 1041 | call-stx 1042 | (expand-type #'call-stx applicable?))))]] 1043 | 1044 | When a @racket[Λ] anonymous type expander appears on its own, in a 1045 | non-applicable position, it is expanded like an 1046 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro} would 1047 | be. 1048 | 1049 | This case is implemented like the @racket[] case, i.e. 1050 | by locally binding a fresh identifier @racket[tmp] to a type expander, and 1051 | then applying that type expander. The difference is that in the 1052 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro} case, 1053 | the syntax object given as an argument to the type expander contains only the 1054 | generated @racket[tmp] identifier. This allows the type expander to easily 1055 | recognise the @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier 1056 | macro} case, where the whole syntax form is an identifier, from regular 1057 | applications, where the whole syntax form is a syntax pair. The whole original 1058 | syntax is attached @racket[cons]ed onto a syntax property named 1059 | @racket['original-Λ-syntax], in (unlikely) case the type expander needs to 1060 | access the original @racket[Λ] syntax used to call it (this is an experimental 1061 | feature, and may change without notice in later versions). 1062 | 1063 | @CHUNK[ 1064 | [{~and whole ({~literal Λ} formals . body)} 1065 | #:when (not applicable?) 1066 | (rule just-Λ/not-applicable 1067 | (with-syntax* ([tmp (syntax-property 1068 | (datum->syntax #'whole 1069 | (gensym '#%Λ-id-macro-) 1070 | #'whole 1071 | #'whole) 1072 | 'original-Λ-syntax 1073 | (cons #'whole 1074 | (or (syntax-property #'whole 1075 | 'original-Λ-syntax) 1076 | null)))] 1077 | [call-stx #'(tmp . tmp)]) 1078 | (with-bindings [tmp (make-type-expander 1079 | )] 1080 | call-stx 1081 | ;; applicable? should be #f here, otherwise it would have been 1082 | ;; caught by other cases. 1083 | (expand-type #'call-stx applicable?))))]] 1084 | 1085 | When a @racket[Λ] anonymous type expander appears on its own, in an applicable 1086 | position, it is returned without modification, so that the containing 1087 | application form may expand it with arguments (instead of expanding it like an 1088 | @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro} would 1089 | be). 1090 | 1091 | @CHUNK[ 1092 | [(~and whole ({~literal Λ} formals . body)) 1093 | #:when applicable? 1094 | (rule just-Λ/applicable 1095 | #'whole)]] 1096 | 1097 | @subsubsection{Preventing the expansion of types with @racket[No-Expand]} 1098 | 1099 | The @racket[No-Expand] special form prevents the type expander from 1100 | re-expanding the result. This is useful for example for the implementation of 1101 | the fancy @racket[quote] expander, which relies on the built-in @racket[quote] 1102 | expander. It is also used to implement shadowing: type variables bound by 1103 | @racket[∀] in non-applicable positions and type variables bound by 1104 | @racket[Rec] are re-bound to type expanders returning 1105 | @racket[(No-Expand original-tvar)]. 1106 | 1107 | @CHUNK[ 1108 | [((~literal No-Expand) T) 1109 | (rule just-No-Expand 1110 | #'T)] 1111 | [(((~literal No-Expand) T) arg ...) 1112 | (rule app-No-Expand 1113 | #`(T #,@(stx-map (λ (τ) (expand-type τ #f)) #'(arg ...))))]] 1114 | 1115 | @subsubsection{The overloaded @racket[:] identifier} 1116 | 1117 | This case handles the colon identifiers @tc[:] (overloaded by this 1118 | library) and @|orig::| (provided by @racketmodname[typed/racket]). Wherever 1119 | the new overloaded @tc[:] identifier appears in a type, we want to convert it 1120 | back to the original @orig:: from @racketmodname[typed/racket]. The goal is 1121 | that a type of the form @racket[(→ Any Boolean : Integer)], using the new 1122 | @tc[:], will get translated to @orig:→AnyBoolean:Integer, using the old 1123 | @orig:: so that it gets properly interpreted by @racketmodname[typed/racket]'s 1124 | parser. 1125 | 1126 | @chunk[ 1127 | [(~and c (~literal new-:)) 1128 | (rule (datum->syntax #'here ': #'c #'c) 1129 | ':)]] 1130 | 1131 | @subsubsection{Last resort cases: leaving the type unchanged} 1132 | 1133 | If the type expression to expand was not matched by any of the above cases, 1134 | then it can still be an application of a polymorphic type @tc[T]. The 1135 | arguments @tc[TArg …] can contain uses of type expanders. We therefore expand 1136 | each separately, and combine the results. 1137 | 1138 | @CHUNK[ 1139 | [{~and whole (T TArg …)} 1140 | (rule app-fallback 1141 | (quasisyntax/loc #'whole 1142 | (T #,@(stx-map (λ (a) (expand-type a #f)) #'(TArg ...)))))]] 1143 | 1144 | As a last resort, we consider that the type @tc[T] (which 1145 | would most likely be an identifier) is either a built-in 1146 | type provided by @tc[typed/racket], or a user-declared type 1147 | introduced by @tc[define-type]. In both cases, we just leave 1148 | the type as-is. 1149 | 1150 | @CHUNK[ 1151 | [T 1152 | (rule just-fallback 1153 | #'T)]] 1154 | 1155 | @subsection{Debugging type expanders} 1156 | 1157 | In order to facilitate writing type expanders, it is possible to print the 1158 | inputs, steps and outputs of the expander using 1159 | @racket[(debug-type-expander #t)], which sets the value of 1160 | @racket[debug-type-expander?]. This can then be undone using 1161 | @racket[(debug-type-expander #f)]. 1162 | 1163 | @chunk[ 1164 | (define debug-type-expander? (box #f))] 1165 | 1166 | @chunk[ 1167 | (define-syntax (debug-type-expander stx) 1168 | (syntax-case stx () 1169 | [(_ #t) (set-box! debug-type-expander? #t) #'(void)] 1170 | [(_ #f) (set-box! debug-type-expander? #f) #'(void)]))] 1171 | 1172 | For better readability, each level of recursion indents the debugging 1173 | information: 1174 | 1175 | @chunk[ 1176 | (define indent (make-parameter 0))] 1177 | 1178 | @chunk[ 1179 | [indent (+ (indent) 3)]] 1180 | 1181 | Before expanding a term, it is printed: 1182 | 1183 | @chunk[ 1184 | (when (unbox debug-type-expander?) 1185 | (printf "~a~a ~a" 1186 | (make-string (indent) #\ ) 1187 | applicable? 1188 | (+scopes stx)))] 1189 | 1190 | Once the term has been expanded, the original term and the expanded term are 1191 | printed: 1192 | 1193 | @chunk[ 1194 | (when (unbox debug-type-expander?) 1195 | (printf "~a~a ~a\n~a=> ~a (case: ~a)\n" 1196 | (make-string (indent) #\ ) 1197 | applicable? 1198 | (+scopes stx) 1199 | (make-string (indent) #\ ) 1200 | (+scopes (car result)) 1201 | (cdr result)) 1202 | (when (= (indent) 0) 1203 | (print-full-scopes))) 1204 | (car result)] 1205 | 1206 | Finally, each rule for the type expander is wrapped with the @racket[rule] 1207 | macro, which prints the name of the rule, and returns a pair containing the 1208 | result and the rule's name, so that the debugging information indicates the 1209 | rule applied at each step. 1210 | 1211 | @chunk[ 1212 | (define-syntax-rule (rule name e) 1213 | (begin (when (unbox debug-type-expander?) 1214 | (printf "(case:~a)\n" 1215 | 'name)) 1216 | (cons e 'name)))] 1217 | 1218 | @section{Overloading @racket[typed/racket] forms} 1219 | 1220 | Throughout this section, we provide alternative definitions of the 1221 | @tc[typed/racket] forms @tc[:], @tc[lambda], @tc[define], @tc[struct], @tc[ann], 1222 | @tc[inst]… . We write these definitions with @tc[syntax-parse], using the syntax 1223 | classes defined in section @secref{type-expander|syntax-classes}. 1224 | 1225 | Most of the time, we will use the experimental @tc[template] macro from 1226 | @tc[syntax/parse/experimental/template] which allows more concise code than the 1227 | usual @code{#'()} and @code{#`()}. 1228 | 1229 | @subsection[#:tag "type-expander|syntax-classes"]{syntax classes} 1230 | 1231 | The syntax classes from 1232 | @tc[typed-racket/base-env/annotate-classes] match against 1233 | the @orig:: literal. Since we provide a new definition for 1234 | it, these syntax classes do not match code using our 1235 | definition of @tc[:]. We therefore cannot use the original 1236 | implementations of @tc[curried-formals] and 1237 | @tc[lambda-formals], and instead have to roll out our own 1238 | versions. 1239 | 1240 | We take that as an opportunity to expand the types directly from the syntax 1241 | classes using @tc[#:with], instead of doing that inside the macros that use 1242 | them. 1243 | 1244 | The @tc[colon] syntax class records the identifier it matches as a "disappeared 1245 | use", which means that DrRacket will draw an arrow from the library importing it 1246 | (either @racketmodname[typed/racket] or @racketmodname[type-expander]) to the 1247 | identifier. Unfortunately, this effect is not (yet) undone by 1248 | @racketmodname[syntax/parse]'s backtracking. See 1249 | @url{https://groups.google.com/forum/#!topic/racket-users/Nc1klmsj9ag} for more 1250 | details about this. 1251 | 1252 | @chunk[ 1253 | (define (remove-ddd stx) 1254 | (remove #'(... ...) (syntax->list stx) free-identifier=?))] 1255 | 1256 | @CHUNK[ 1257 | (define-syntax-class colon 1258 | #:attributes () 1259 | (pattern (~and {~or {~literal new-:} {~literal :}} 1260 | C 1261 | {~do (record-disappeared-uses (list #'C))}))) 1262 | 1263 | (define-splicing-syntax-class new-maybe-kw-type-vars 1264 | #:attributes ([vars 1] maybe) 1265 | (pattern kw+vars:lambda-type-vars 1266 | #:with (vars …) (remove-ddd #'kw+vars.type-vars) 1267 | #:with maybe #'kw+vars) 1268 | (pattern (~seq) 1269 | #:with (vars …) #'() 1270 | #:attr maybe #f)) 1271 | 1272 | (define-splicing-syntax-class new-maybe-type-vars 1273 | #:attributes ([vars 1] maybe) 1274 | (pattern v:type-variables 1275 | #:with (vars …) (remove-ddd #'v) 1276 | #:with maybe #'v) 1277 | (pattern (~seq) 1278 | #:with (vars …) #'() 1279 | #:attr maybe #f)) 1280 | 1281 | (define-splicing-syntax-class new-kw-formal 1282 | #:attributes ([expanded 1]) 1283 | (pattern (~seq kw:keyword id:id) 1284 | #:with (expanded ...) #'(kw id)) 1285 | (pattern (~seq kw:keyword [id:id 1286 | (~optional (~seq :colon type:type-expand!)) 1287 | (~optional default:expr)]) 1288 | #:with (expanded ...) 1289 | (template (kw [id (?@ : type.expanded) 1290 | (?? default)])))) 1291 | 1292 | (define-splicing-syntax-class new-mand-formal 1293 | #:attributes ([expanded 1]) 1294 | (pattern id:id 1295 | #:with (expanded ...) #'(id)) 1296 | (pattern [id:id :colon type:type-expand!] 1297 | #:with (expanded ...) 1298 | (template ([id : type.expanded]))) 1299 | (pattern kw:new-kw-formal 1300 | #:with (expanded ...) #'(kw.expanded ...))) 1301 | 1302 | (define-splicing-syntax-class new-opt-formal 1303 | #:attributes ([expanded 1]) 1304 | (pattern [id:id 1305 | (~optional (~seq :colon type:type-expand!)) 1306 | default:expr] 1307 | #:with (expanded ...) 1308 | (template ([id (?? (?@ : type.expanded)) 1309 | default]))) 1310 | (pattern kw:new-kw-formal 1311 | #:with (expanded ...) #'(kw.expanded ...))) 1312 | 1313 | (define-syntax-class new-rest-arg 1314 | #:attributes ([expanded 0]) 1315 | (pattern rest:id 1316 | #:with expanded #'rest) 1317 | (pattern (rest:id 1318 | :colon type:type-expand! 1319 | (~or (~and x* (~describe "*" (~or (~literal *) 1320 | (~literal ...*)))) 1321 | (~seq (~literal ...) bound:type-expand!))) 1322 | #:with expanded 1323 | (template (rest : type.expanded 1324 | (?? x* 1325 | (?@ (... ...) bound.expanded)))))) 1326 | 1327 | (define-syntax-class new-lambda-formals 1328 | (pattern (~or (mand:new-mand-formal ... 1329 | opt:new-opt-formal ... 1330 | . rest:new-rest-arg) 1331 | (mand:new-mand-formal ... 1332 | opt:new-opt-formal ...)) 1333 | ;; TODO: once template supports ?? in tail position, use it. 1334 | #:with expanded #`(mand.expanded ... 1335 | ... 1336 | opt.expanded ... 1337 | ... 1338 | . #,(if (attribute rest) 1339 | #'rest.expanded 1340 | #'())))) 1341 | 1342 | (define-syntax-class (new-curried-formals def-id) 1343 | (pattern (f:id . args:new-lambda-formals) 1344 | #:with expanded #`(#,def-id . args.expanded)) 1345 | (pattern ((~var lhs (new-curried-formals def-id)) 1346 | . args:new-lambda-formals) 1347 | #:with expanded #'(lhs.expanded . args.expanded))) 1348 | 1349 | (define-syntax-class new-curried-formals-id 1350 | (pattern (id:id . _)) 1351 | (pattern (lhs:new-curried-formals-id . _) 1352 | #:with id #'lhs.id)) 1353 | 1354 | (define-splicing-syntax-class new-optionally-annotated-name 1355 | (pattern (~seq name:id (~optional (~seq :colon type:type-expand!))) 1356 | #:with expanded 1357 | (template (name 1358 | (?? (?@ : type.expanded)))))) 1359 | 1360 | (define-syntax-class new-name-or-parenthesised-annotated-name 1361 | (pattern name:id 1362 | #:with expanded #'name) 1363 | (pattern [id:id :colon type:type-expand!] 1364 | #:with expanded 1365 | (template [id : type.expanded])))] 1366 | 1367 | @subsection{Overview of the overloaded primitives} 1368 | 1369 | The following sections merely define overloads for the 1370 | @racketmodname[typed/racket] primitives. The process is 1371 | similar each time: a new primitive is defined, e.g. 1372 | @tc[new-:] for @|orig::|. The new primitive calls the old one, 1373 | after having expanded (using @tc[expand-type]) all parts of 1374 | the syntax which contain types. Aside from heavy usage of 1375 | @tc[syntax-parse], there is not much to say concerning these 1376 | definitions. 1377 | 1378 | @subsection{@racket[:]} 1379 | 1380 | @CHUNK[<:> 1381 | (set-:-impl! (syntax-parser 1382 | [(_ x:id t:expr) 1383 | #`(: x #,(expand-type #'t #f))]))] 1384 | 1385 | @subsection{@racket[define-type]} 1386 | 1387 | @chunk[ 1388 | (define-syntax new-define-type 1389 | (syntax-parser 1390 | [(_ (~or name:id (name:id maybe-tvar:id …)) . whole-rest) 1391 | #:with (tvar …) (if (attribute maybe-tvar) #'(maybe-tvar …) #'()) 1392 | #:with (tvar-not-ooo …) (filter (λ (tv) (not (free-identifier=? tv #'(… …)))) 1393 | (syntax->list #'(tvar …))) 1394 | (start-tl-redirections 1395 | (with-bindings [(tvar-not-ooo …) (stx-map 1396 | #'(tvar-not-ooo …))] 1397 | whole-rest 1398 | (syntax-parse #'whole-rest 1399 | [(type:type-expand! . rest) 1400 | (template 1401 | (define-type (?? (name tvar …) name) 1402 | type.expanded 1403 | . rest))])))]))] 1404 | 1405 | @subsection{@racket[define]} 1406 | 1407 | @chunk[ 1408 | (define-syntax new-define 1409 | (f-start-tl-redirections 1410 | (syntax-parser 1411 | [(_ {~and (~seq _:new-maybe-kw-type-vars 1412 | (~or v:id 1413 | formals-id:new-curried-formals-id) 1414 | _ …) 1415 | (~with-tvars (tvars new-maybe-kw-type-vars) 1416 | (~or _:id 1417 | (~var formals (new-curried-formals 1418 | #'formals-id.id))) 1419 | (~optional (~seq :colon type:type-expand!)) 1420 | e ...)}) 1421 | (template 1422 | (define (?? (?@ . tvars.maybe)) (?? v formals.expanded) 1423 | (?? (?@ : type.expanded)) 1424 | e ...))])))] 1425 | 1426 | @subsection{@racket[lambda]} 1427 | 1428 | @CHUNK[ 1429 | (define-syntax new-lambda 1430 | (f-start-tl-redirections 1431 | (syntax-parser 1432 | [(_ {~with-tvars (tvars new-maybe-kw-type-vars) 1433 | args:new-lambda-formals 1434 | (~optional (~seq :colon ret-type:type-expand!)) 1435 | e …}) 1436 | (template (lambda (?? (?@ . tvars.maybe)) args.expanded 1437 | (?? (?@ : ret-type.expanded)) 1438 | e ...))])))] 1439 | 1440 | @subsection{@racket[case-lambda]} 1441 | 1442 | @CHUNK[ 1443 | (define-syntax new-case-lambda 1444 | (f-start-tl-redirections 1445 | (syntax-parser 1446 | [(_ {~with-tvars (tvars new-maybe-kw-type-vars) 1447 | [args:new-lambda-formals 1448 | (~optional (~seq :colon ret-type:type-expand!)) 1449 | e …] 1450 | …}) 1451 | (template (case-lambda 1452 | (?? (?@ #:∀ tvars.maybe)) 1453 | [args.expanded 1454 | (?? (ann (let () e …) ret-type.expanded) 1455 | (?@ e …))] 1456 | …))])))] 1457 | 1458 | @subsection{@racket[struct]} 1459 | 1460 | The name must be captured outside of the @racket[~with-tvars], as 1461 | @racket[~with-tvars] introduces everything in a new lexical context. 1462 | 1463 | @chunk[ 1464 | (define-syntax new-struct 1465 | (f-start-tl-redirections 1466 | (syntax-parser 1467 | [(_ (~and 1468 | (~seq _:new-maybe-type-vars 1469 | (~and (~seq name+parent …) 1470 | (~or (~seq name:id) 1471 | (~seq name:id parent:id))) 1472 | _ …) 1473 | {~with-tvars (tvars new-maybe-type-vars) 1474 | (~or (~seq _:id) 1475 | (~seq _:id _:id)) 1476 | ([field:id :colon type:type-expand!] ...) 1477 | rest …})) 1478 | (template (struct (?? tvars.maybe) name (?? parent) 1479 | ([field : type.expanded] ...) 1480 | rest …))])))] 1481 | 1482 | @subsection{@racket[define-struct/exec]} 1483 | 1484 | @chunk[ 1485 | (define-syntax (new-define-struct/exec stx) 1486 | (syntax-parse stx 1487 | [(_ (~and name+parent (~or name:id [name:id parent:id])) 1488 | ([field:id (~optional (~seq :colon type:type-expand!))] ...) 1489 | [proc :colon proc-type:type-expand!]) 1490 | (template (define-struct/exec name+parent 1491 | ([field (?? (?@ : type.expanded))] ...) 1492 | [proc : proc-type.expanded]))]))] 1493 | 1494 | @subsection{@racket[ann]} 1495 | 1496 | @chunk[ 1497 | (define-syntax/parse (new-ann value:expr 1498 | (~optional :colon) type:type-expand!) 1499 | (template (ann value type.expanded)))] 1500 | 1501 | @subsection{@racket[cast]} 1502 | 1503 | @chunk[ 1504 | (define-syntax/parse (new-cast value:expr type:type-expand!) 1505 | (template (cast value type.expanded)))] 1506 | 1507 | @subsection{@racket[unsafe-cast]} 1508 | 1509 | We additionally define an @racket[unsafe-cast] macro, which Typed/Racket does 1510 | not provide yet, but can easily be defined using @racket[unsafe-require/typed] 1511 | and a polymorphic function. 1512 | 1513 | @chunk[ 1514 | (module m-unsafe-cast typed/racket 1515 | (provide unsafe-cast-function) 1516 | (define (unsafe-cast-function [v : Any]) v)) 1517 | 1518 | (require (only-in typed/racket/unsafe unsafe-require/typed)) 1519 | (unsafe-require/typed 'm-unsafe-cast 1520 | [unsafe-cast-function (∀ (A) (→ Any A))]) 1521 | 1522 | (define-syntax-rule (unsafe-cast/no-expand v t) 1523 | ((inst unsafe-cast-function t) v)) 1524 | 1525 | (define-syntax/parse (unsafe-cast value:expr type:type-expand!) 1526 | (template (unsafe-cast/no-expand value type.expanded)))] 1527 | 1528 | @subsection{@racket[inst]} 1529 | 1530 | @chunk[ 1531 | (define-syntax new-inst 1532 | (syntax-parser 1533 | [(_ v (~optional :colon) t:type-expand! ... 1534 | last:type-expand! (~literal ...) b:id) 1535 | (template (inst v 1536 | t.expanded ... 1537 | last.expanded (... ...) b))] 1538 | [(_ v (~optional :colon) t:type-expand! ...) 1539 | (template (inst v t.expanded ...))]))] 1540 | 1541 | @subsection{@racket[row-inst]} 1542 | 1543 | @chunk[ 1544 | (define-syntax/parse (new-inst e row:type-expand!) 1545 | (template (row-inst e row.expanded)))] 1546 | 1547 | @subsection{@racket[let]} 1548 | 1549 | @chunk[ 1550 | (define-syntax new-let 1551 | (f-start-tl-redirections 1552 | (syntax-parser 1553 | [(_ (~optional (~seq loop:id 1554 | (~optional 1555 | (~seq :colon return-type:type-expand!)))) 1556 | (~with-tvars (tvars new-maybe-kw-type-vars) 1557 | ([name:new-optionally-annotated-name e:expr] ...) 1558 | rest ...)) 1559 | (template 1560 | (let (?? (?@ loop (?? (?@ : return-type.expanded)))) 1561 | (?@ . tvars) 1562 | ([(?@ . name.expanded) e] ...) 1563 | rest ...))])))] 1564 | 1565 | @subsection{@racket[let*]} 1566 | 1567 | @chunk[ 1568 | (define-syntax/parse 1569 | (new-let* 1570 | ([name:new-optionally-annotated-name e:expr] ...) 1571 | . rest) 1572 | (template 1573 | (let* ([(?@ . name.expanded) e] ...) . rest)))] 1574 | 1575 | @subsection{@racket[let-values]} 1576 | 1577 | @chunk[ 1578 | (define-syntax/parse 1579 | (new-let-values 1580 | ([(name:new-name-or-parenthesised-annotated-name ...) e:expr] ...) 1581 | . rest) 1582 | (template 1583 | (let-values ([(name.expanded ...) e] ...) 1584 | . rest)))] 1585 | 1586 | @subsection{@racket[make-predicate]} 1587 | 1588 | @chunk[ 1589 | (define-simple-macro (new-make-predicate type:type-expand!) 1590 | (make-predicate type.expanded))] 1591 | 1592 | @subsection{@racket[:type], @racket[:print-type], @racket[:query-type/args], 1593 | @racket[:query-type/result]} 1594 | 1595 | @chunk[<:type> 1596 | (define-syntax/parse (new-:type (~optional (~and verbose #:verbose)) 1597 | type:type-expand!) 1598 | (template (eval #'(#%top-interaction 1599 | . (:type (?? verbose) type.expanded)))))] 1600 | 1601 | @chunk[<:print-type> 1602 | (define-syntax/parse (new-:print-type e:expr) 1603 | #'(:print-type e) 1604 | #'(eval #'(#%top-interaction 1605 | . (:print-type e))))] 1606 | 1607 | @chunk[<:query-type/args> 1608 | (define-syntax/parse (new-:query-type/args f type:type-expand! …) 1609 | #'(eval #'(#%top-interaction 1610 | . (:query-type/args f type.expanded …))))] 1611 | 1612 | @chunk[<:query-type/result> 1613 | (define-syntax/parse (new-:query-type/result f type:type-expand!) 1614 | #'(eval #'(#%top-interaction 1615 | . (:query-type/result f type.expanded))))] 1616 | 1617 | @subsection{Type expanders for the typed classes} 1618 | 1619 | Not all forms are supported for now. 1620 | 1621 | @chunk[ 1622 | (define-syntax-class field-decl 1623 | (pattern id:id #:with expanded #'(field id)) 1624 | (pattern (maybe-renamed {~optional {~seq :colon type:type-expand!}} 1625 | {~optional default-value-expr}) 1626 | #:with expanded 1627 | (template (maybe-renamed (?? (?@ : type.expanded)) 1628 | (?? default-value-expr)))))] 1629 | 1630 | @chunk[ 1631 | (define-syntax-class field-clause 1632 | #:literals (field) 1633 | (pattern (field field-decl:field-decl …) 1634 | #:with expanded (template (field field-decl.expanded …))))] 1635 | 1636 | @chunk[ 1637 | (define-syntax-class super-new-clause 1638 | #:literals (super-new) 1639 | (pattern (super-new . rest) 1640 | #:with expanded (template (super-new . rest))))] 1641 | 1642 | @;{ 1643 | @chunk[ 1644 | (set-field-impl! 1645 | (syntax-parser [clause:field-clause #'clause.expanded]))] 1646 | 1647 | @chunk[ 1648 | (set-super-new-impl! 1649 | (syntax-parser [clause:super-new-clause #'clause.expanded]))]} 1650 | 1651 | 1652 | @chunk[ 1653 | (define-syntax-class class-clause 1654 | #:attributes (expanded) 1655 | (pattern :field-clause) 1656 | (pattern :super-new-clause))] 1657 | 1658 | @chunk[ 1659 | (define-syntax new-class 1660 | (f-start-tl-redirections 1661 | (syntax-parser 1662 | [(_ superclass-expr 1663 | {~with-tvars (tvars new-maybe-kw-type-vars) 1664 | clause:class-clause ...}) 1665 | (template (class superclass-expr 1666 | (?? (?@ . tvars.maybe)) 1667 | clause.expanded ...))])))] 1668 | 1669 | @subsection[#:tag "type-expander|other-forms"]{Other @racket[typed/racket] 1670 | forms} 1671 | 1672 | The other @tc[typed/racket] forms below do not have an alternative definition 1673 | yet. 1674 | 1675 | @chunk[ 1676 | (define-syntax (missing-forms stx) 1677 | (syntax-parse stx 1678 | [(_ name ...) 1679 | (define/with-syntax (tmp ...) (generate-temporaries #'(name ...))) 1680 | #'(begin 1681 | (begin 1682 | (define-syntax (tmp stx) 1683 | (raise-syntax-error 1684 | 'name 1685 | (format "~a not implemented yet for type-expander" 'name) 1686 | stx)) 1687 | (provide (rename-out [tmp name]))) 1688 | ...)])) 1689 | 1690 | (missing-forms 1691 | (code:comment ";TODO: add all-defined-out in prims.rkt") 1692 | (code:comment "; top-interaction.rkt") 1693 | (code:comment ":type") 1694 | (code:comment ":print-type") 1695 | (code:comment ":query-type/args") 1696 | (code:comment ":query-type/result") 1697 | (code:comment "; case-lambda.rkt") 1698 | (code:comment "case-lambda") 1699 | (code:comment "case-lambda:") 1700 | pcase-lambda: 1701 | (code:comment "; (submod \"prims-contract.rkt\" forms)") 1702 | require/opaque-type 1703 | (code:comment "require-typed-struct-legacy") 1704 | require-typed-struct 1705 | (code:comment "require/typed-legacy") 1706 | require/typed 1707 | require/typed/provide 1708 | require-typed-struct/provide 1709 | (code:comment "cast") 1710 | (code:comment "make-predicate") 1711 | define-predicate 1712 | (code:comment "; prims.rkt") 1713 | define-type-alias 1714 | define-new-subtype 1715 | define-typed-struct 1716 | define-typed-struct/exec 1717 | (code:comment "ann") 1718 | (code:comment "inst") 1719 | (code:comment ":") 1720 | define-struct: 1721 | define-struct 1722 | (code:comment "struct") 1723 | struct: 1724 | λ: 1725 | lambda: 1726 | (code:comment "lambda") 1727 | (code:comment "λ") 1728 | (code:comment "define") 1729 | (code:comment "let") 1730 | (code:comment "let*") 1731 | letrec 1732 | (code:comment "let-values") 1733 | letrec-values 1734 | let/cc 1735 | let/ec 1736 | let: 1737 | let*: 1738 | letrec: 1739 | let-values: 1740 | letrec-values: 1741 | let/cc: 1742 | let/ec: 1743 | for 1744 | for/list 1745 | for/vector 1746 | for/hash 1747 | for/hasheq 1748 | for/hasheqv 1749 | for/and 1750 | for/or 1751 | for/sum 1752 | for/product 1753 | for/lists 1754 | for/first 1755 | for/last 1756 | for/fold 1757 | for* 1758 | for*/list 1759 | for*/lists 1760 | for*/vector 1761 | for*/hash 1762 | for*/hasheq 1763 | for*/hasheqv 1764 | for*/and 1765 | for*/or 1766 | for*/sum 1767 | for*/product 1768 | for*/first 1769 | for*/last 1770 | for*/fold 1771 | for/set 1772 | for*/set 1773 | do 1774 | do: 1775 | with-handlers 1776 | define-struct/exec: 1777 | (code:comment "define-struct/exec"))] 1778 | 1779 | @section{Future work} 1780 | 1781 | We have not implemented alternative type-expanding definitions for all the 1782 | @tc[typed/racket] forms, as noted in @secref{type-expander|other-forms}. 1783 | 1784 | Integrating the type expander directly into typed/racket 1785 | would avoid the need to provide such definitions, and allow 1786 | using type expanders in vanilla @tc[typed/racket], instead 1787 | of having to @racket[require] this library. However, the 1788 | code wrapping the @tc[typed/racket] forms could be re-used 1789 | by other libraries that alter the way @tc[typed/racket] 1790 | works, so implementing the remaining forms could still be 1791 | useful. 1792 | 1793 | Also, we would need to provide a @tc[syntax-local-type-introduce] function, 1794 | similar to the @tc[syntax-local-match-introduce] function provided by @tc[match] 1795 | for example. 1796 | 1797 | @section{Conclusion} 1798 | 1799 | When an identifier is @racket[require]d from another module, 1800 | it is not the same as the one visible within the defining 1801 | module. This is a problem for @tc[:], because we match 1802 | against it in our syntax classes, using @tc[(~literal :)], 1803 | but when it is written in another module, for example 1804 | @tc[(define foo : Number 42)], it is not the same identifier 1805 | as the one used by original definition of @tc[:], and 1806 | therefore the @tc[(~literal :)] won't match. I suspect that 1807 | issue to be due to contract wrappers added by 1808 | @tc[typed/racket]. 1809 | 1810 | To get around that problem, we define @tc[:] in a separate module, and 1811 | @racket[require] it in the module containing the syntax classes: 1812 | 1813 | Since our @tc[new-:] macro needs to call the 1814 | @tc[type-expander], and the other forms too, we cannot 1815 | define @tc[type-expander] in the same module as these forms, 1816 | it needs to be either in the same module as @tc[new-:], or 1817 | in a separate module. Additionally, @tc[expand-type] needs 1818 | to be required @tc[for-syntax] by the forms, but needs to be 1819 | @tc[provide]d too, so it is much easier if it is defined in 1820 | a separate module (that will be used only by macros, so it 1821 | will be written in @tc[racket], not @tc[typed/racket]). 1822 | 1823 | @chunk[ 1824 | (module expander racket 1825 | (require (for-template typed/racket 1826 | "identifiers.rkt") 1827 | racket 1828 | (only-in racket/base [... …]) 1829 | syntax/parse 1830 | racket/format 1831 | racket/syntax 1832 | syntax/id-table 1833 | syntax/stx 1834 | auto-syntax-e 1835 | "parameterize-lexical-context.rkt" 1836 | debug-scopes 1837 | racket/contract/base) 1838 | ;; TODO: move this in a separate chunk and explain it 1839 | 1840 | (provide prop:type-expander 1841 | (contract-out 1842 | (rename has-prop:type-expander? 1843 | prop:type-expander? 1844 | (-> any/c boolean?)) 1845 | (rename get-prop:type-expander-value 1846 | prop:type-expander-ref 1847 | (-> has-prop:type-expander? 1848 | any/c))) 1849 | type-expander 1850 | apply-type-expander 1851 | ;bind-type-vars 1852 | expand-type 1853 | type 1854 | stx-type/c 1855 | type-expand! 1856 | debug-type-expander? 1857 | patched 1858 | make-type-expander) 1859 | 1860 | 1861 | 1862 | 1863 | 1864 | 1865 | 1866 | 1867 | 1868 | 1869 | ; 1870 | 1871 | 1872 | 1873 | 1874 | )] 1875 | 1876 | We can finally define the overloaded forms, as well as the 1877 | @tc[] form. 1878 | 1879 | @chunk[ 1880 | (module main typed/racket 1881 | (require (only-in typed/racket/base [... …]) 1882 | typed/racket/class 1883 | (for-syntax racket 1884 | (only-in racket/base [... …]) 1885 | racket/syntax 1886 | syntax/parse 1887 | syntax/parse/experimental/template 1888 | syntax/id-table 1889 | "parameterize-lexical-context.rkt" 1890 | syntax/stx) 1891 | (for-meta 2 racket/base syntax/parse) 1892 | "utils.rkt" 1893 | syntax/parse/define 1894 | "identifiers.rkt") 1895 | 1896 | (require (submod ".." expander)) 1897 | (require (for-syntax (submod ".." expander))) 1898 | (require (for-syntax typed-racket/base-env/annotate-classes)) 1899 | 1900 | (provide prop:type-expander 1901 | prop:type-expander? 1902 | prop:type-expander-ref 1903 | expand-type 1904 | define-type-expander 1905 | patch-type-expander 1906 | Let 1907 | Letrec 1908 | Λ 1909 | ...* 1910 | No-Expand 1911 | unsafe-cast/no-expand 1912 | unsafe-cast 1913 | debug-type-expander 1914 | (rename-out [new-: :] 1915 | [new-define-type define-type] 1916 | [new-define define] 1917 | [new-lambda lambda] 1918 | [new-lambda λ] 1919 | [new-case-lambda case-lambda] 1920 | [new-case-lambda case-lambda:] 1921 | [new-struct struct] 1922 | [new-define-struct/exec define-struct/exec] 1923 | [new-ann ann] 1924 | [new-cast cast] 1925 | [new-inst inst] 1926 | [new-let let] 1927 | [new-let* let*] 1928 | [new-let-values let-values] 1929 | [new-make-predicate make-predicate] 1930 | [new-:type :type] 1931 | [new-:print-type :print-type] 1932 | [new-:query-type/args :query-type/args] 1933 | [new-:query-type/result :query-type/result] 1934 | ;[new-field field] 1935 | ;[new-super-new super-new] 1936 | [new-class class])) 1937 | 1938 | (begin-for-syntax 1939 | (define-syntax ~with-tvars 1940 | (pattern-expander 1941 | (syntax-parser 1942 | [(_ (tv tv-stxclass) pat ...) 1943 | #'{~seq {~var tmp-tv tv-stxclass} 1944 | {~seq whole-rest (... ...)} 1945 | {~parse (({~var tv tv-stxclass}) pat ...) 1946 | ;; rebind tvars: 1947 | (with-bindings [(tmp-tv.vars (... ...)) 1948 | (stx-map 1949 | #'(tmp-tv.vars (... ...)))] 1950 | ;; rebind occurrences of the tvars within: 1951 | (tmp-tv whole-rest (... ...)) 1952 | ;; to (re-)parse: 1953 | #'(tmp-tv whole-rest (... ...)))}}])))) 1954 | 1955 | 1956 | 1957 | <:> 1958 | 1959 | 1960 | 1961 | 1962 | (begin-for-syntax 1963 | 1964 | 1965 | 1966 | (provide colon)) 1967 | 1968 | 1969 | 1970 | 1971 | 1972 | 1973 | 1974 | 1975 | 1976 | 1977 | 1978 | 1979 | 1980 | 1981 | 1982 | <:type> 1983 | <:print-type> 1984 | <:query-type/args> 1985 | <:query-type/result> 1986 | ; 1987 | 1988 | ; 1989 | )] 1990 | 1991 | We can now assemble the modules in this order: 1992 | 1993 | @chunk[<*> 1994 | 1995 | 1996 | 1997 | (require 'main) 1998 | (provide (except-out (all-from-out 'main) (for-syntax colon)))] 1999 | --------------------------------------------------------------------------------