786 lines
30 KiB
Racket
786 lines
30 KiB
Racket
#lang scribble/lp2
|
|
@(require "../lib/doc.rkt")
|
|
@doc-lib-setup
|
|
|
|
@title[#:style manual-doc-style]{Extensible types}
|
|
|
|
We want to have extensible types. Unlike @tc[require] and @tc[provide], which
|
|
come with @tc[define-require-syntax] and @tc[define-provide-syntax], and unlike
|
|
@tc[match], which comes with @tc[define-match-expander], @tc[typed/racket]
|
|
doesn't provide a way to define type expanders (yet).
|
|
|
|
We re-define the forms @tc[:], @tc[define], @tc[lambda] etc. to equivalents that
|
|
expand type expanders defined via our macro @tc[define-type-expander]. Ideally,
|
|
this would be handled directly by @tc[typed/racket], which would call the
|
|
type-expander itself.
|
|
|
|
@(table-of-contents)
|
|
|
|
@section{@racket[prop:type-expander]}
|
|
|
|
Match expanders are identified by the @tc[prop:type-expander]
|
|
@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{structure type
|
|
property}, which allows the same identifier to act as a
|
|
@tc[prop:rename-transformer], @tc[prop:match-expander] and
|
|
@tc[prop:type-expander] for example.
|
|
|
|
@chunk[<prop:type-expander>
|
|
(define-values (prop:type-expander
|
|
has-prop:type-expander?
|
|
get-prop:type-expander-value)
|
|
(make-struct-type-property 'type-expander prop-guard))]
|
|
|
|
The @tc[prop:type-expander] property should either be the index of a field which
|
|
will contain the expander procedure, or directly an expander procedure.
|
|
|
|
@chunk[<prop-guard>
|
|
(define (prop-guard val struct-type-info-list)
|
|
(cond <prop-guard-field-index>
|
|
<prop-guard-procedure>
|
|
[else
|
|
(raise-argument-error
|
|
'prop:type-expander-guard
|
|
(~a "a procedure of arity 1, or an exact non-negative integer "
|
|
"designating a field index within the structure that "
|
|
"should contain a procedure of arity 1.")
|
|
val)]))]
|
|
|
|
If the value is a field index, it should be within bounds. The
|
|
@tc[make-struct-field-accessor] function does that for us, and also returns
|
|
an accessor that can be passed directly an instance of the struct.
|
|
|
|
@chunk[<prop-guard-field-index>
|
|
[(exact-nonnegative-integer? val)
|
|
(make-struct-field-accessor (cadddr struct-type-info-list) val)]]
|
|
|
|
The expander procedure will take one argument: the piece of syntax corresponding
|
|
to the use of the expander. If the property's value is a procedure, we therefore
|
|
check that the it's arity includes 1.
|
|
|
|
When the property value is a field index, we return a field accessor, that when
|
|
given the struct instance, will return the actual type expander procedure.
|
|
We therfore need to follow the same convention here, by wrapping val in a
|
|
single-parameter function.
|
|
|
|
@chunk[<prop-guard-procedure>
|
|
[(procedure? val)
|
|
(if (arity-includes? (procedure-arity val) 1)
|
|
(λ (_) val)
|
|
(raise-argument-error 'prop:type-expander-guard
|
|
"procedure arity should be 1"
|
|
val))]]
|
|
|
|
@subsection{type-expander struct}
|
|
|
|
We make a simple struct that implements just @tc[prop:type-expander] and nothing
|
|
else.
|
|
|
|
@chunk[<type-expander-struct>
|
|
(struct type-expander (expander-proc)
|
|
#:property prop:type-expander (struct-field-index expander-proc))]
|
|
|
|
@section{@racket[expand-type]}
|
|
|
|
@chunk[<apply-type-expander>
|
|
(define (apply-type-expander type-expander-stx stx)
|
|
(let ([type-expander (syntax-local-value type-expander-stx)])
|
|
(((get-prop:type-expander-value type-expander) type-expander) stx)))]
|
|
|
|
@CHUNK[<bind-type-vars>
|
|
(define (bind-type-vars type-vars [env (make-immutable-free-id-table)])
|
|
(foldl (λ (v acc) (free-id-table-set acc v #f))
|
|
env
|
|
(syntax->list type-vars))
|
|
#;(let ([def-ctx (syntax-local-make-definition-context)]
|
|
[err-expr #'(λ _ (raise-syntax-error
|
|
"Type name used out of context"))])
|
|
(for ([var (syntax-parse type-vars
|
|
[(v:id …) (syntax->list #'(v …))])])
|
|
(syntax-local-bind-syntaxes (list var) err-expr def-ctx))
|
|
(internal-definition-context-seal def-ctx)
|
|
(internal-definition-context-introduce def-ctx stx 'add)))]
|
|
|
|
@CHUNK[<let-type-todo>
|
|
(define (let-type-todo id expr env)
|
|
(free-id-table-set env id expr)
|
|
#;(let ([def-ctx (syntax-local-make-definition-context)])
|
|
(syntax-local-bind-syntaxes (list id)
|
|
#'(lambda _
|
|
(displayln 'expr)
|
|
(error "errr"))
|
|
def-ctx)
|
|
(internal-definition-context-seal def-ctx)
|
|
(internal-definition-context-introduce def-ctx stx)))]
|
|
|
|
@CHUNK[<expand-type>
|
|
(define (expand-type stx [env (make-immutable-free-id-table)])
|
|
(define-syntax-class (type-expander env)
|
|
(pattern (~var expander
|
|
(static has-prop:type-expander? "a type expander"))
|
|
#:when (not (dict-has-key? env #'expander))
|
|
#:with code #'expander)
|
|
(pattern expander:id
|
|
#:attr code (free-id-table-ref env #'expander (λ () #f))
|
|
#:when (attribute code)))
|
|
(define-syntax-class (type-expander-nested-application env)
|
|
#:attributes (expanded-once)
|
|
(pattern (~and expander-call-stx
|
|
((~var expander (type-expander env)) . args))
|
|
#:with expanded-once
|
|
(apply-type-expander #'expander.code #'expander-call-stx))
|
|
(pattern ((~var nested-application
|
|
(type-expander-nested-application env))
|
|
. args) ;; TODO: test
|
|
#:with expanded-once
|
|
#'(nested-application.expanded-once . args))
|
|
(pattern (~and xxx (~datum ~>))
|
|
#:with expanded-once #'()
|
|
#:when (display (format "dict =\n "))
|
|
#:when (displayln (dict->list env))
|
|
#:when (displayln #'xxx)
|
|
#:when (newline)
|
|
#:when (pretty-write (map syntax-debug-info
|
|
(map car (dict->list env))))
|
|
#:when (pretty-write (syntax-debug-info #'xxx))
|
|
#:when #f))
|
|
|
|
(define-syntax-class fa (pattern (~or (~literal ∀) (~literal All))))
|
|
(syntax-parse stx
|
|
[(~datum :) ;; TODO: This is a hack, we should use ~literal.
|
|
#':]
|
|
[(~var expander (type-expander env))
|
|
(expand-type (apply-type-expander #'expander.code #'expander) env)]
|
|
[(~var nested-application (type-expander-nested-application env))
|
|
(expand-type #'nested-application.expanded-once env)]
|
|
;; TODO: find a more elegant way to write anonymous type expanders
|
|
[(((~literal curry) T Arg1 …) . Args2)
|
|
(expand-type #'(T Arg1 … . Args2) env)]
|
|
;; TODO: handle the pattern (∀ (TVar ... ooo) T)
|
|
[(∀:fa (TVar:id ...) T:expr)
|
|
#`(∀ (TVar ...)
|
|
#,(expand-type #'T (bind-type-vars #'(TVar ...) env)))]
|
|
[((~literal Rec) R:id T:expr)
|
|
#`(Rec R #,(expand-type #'T (bind-type-vars #'(R) env)))]
|
|
[((~commit (~datum Let)) bindings T:expr)
|
|
;; TODO: ~literal instead of ~datum
|
|
(syntax-parse #'bindings
|
|
;; TODO : for now we only allow aliasing (which means E is an id),
|
|
;; not on-the-fly declaration of type expanders. This would require
|
|
;; us to (expand) them.
|
|
[[V:id E:id] ;; TODO: remove the single-binding clause case in Let
|
|
#`#,(expand-type #'T (let-type-todo #'V #'E env))]
|
|
[()
|
|
#`#,(expand-type #'T env)]
|
|
[([V₀:id E₀:id] [Vᵢ:id Eᵢ:id] …)
|
|
#`#,(expand-type #'(Let ([Vᵢ Eᵢ] …) T)
|
|
(let-type-todo #'V₀ #'E₀ env))])]
|
|
[((~literal quote) T) (expand-quasiquote 'quote 1 env #'T)]
|
|
[((~literal quasiquote) T) (expand-quasiquote 'quasiquote 1 env #'T)]
|
|
[((~literal syntax) T) (expand-quasiquote 'syntax 1 env #'T)]
|
|
[((~literal quasisyntax) T) (expand-quasiquote 'quasisyntax 1 env
|
|
#'T)]
|
|
[((~literal Struct) T)
|
|
#`(Struct #,(expand-type #'T env))]
|
|
[(T TArg ...)
|
|
#`(T #,@(stx-map (λ (a) (expand-type a env)) #'(TArg ...)))]
|
|
[T #'T]))]
|
|
|
|
@CHUNK[<define-type-expander>
|
|
(define-syntax/parse (define-type-expander (name:id arg:id) . body)
|
|
#`(define-syntax name
|
|
(type-expander #,(syntax/loc stx (λ (arg) . body)))))]
|
|
|
|
@section{Example type-expanders: quasiquote and quasisyntax}
|
|
|
|
@CHUNK[<expand-quasiquote>
|
|
(define (expand-quasiquote mode depth env stx)
|
|
(define (wrap t)
|
|
(if (or (eq? mode 'syntax) (eq? mode 'quasisyntax))
|
|
#`(Syntaxof #,t)
|
|
t))
|
|
(define (wrap-quote t)
|
|
(if (or (eq? mode 'syntax) (eq? mode 'quasisyntax))
|
|
#`(Syntaxof (quote #,t))
|
|
#`(quote #,t)))
|
|
(define expand-quasiquote-rec (curry expand-quasiquote mode depth env))
|
|
(syntax-parse stx
|
|
[((~literal quote) T)
|
|
(wrap #`(List #,(wrap-quote #'quote)
|
|
#,(expand-quasiquote-rec #'T)))]
|
|
[((~literal quasiquote) T)
|
|
(wrap #`(List #,(wrap-quote #'quasiquote)
|
|
#,(if (eq? mode 'quasiquote)
|
|
(expand-quasiquote mode (+ depth 1) env #'T)
|
|
(expand-quasiquote-rec #'T))))]
|
|
[((~literal unquote) T)
|
|
(if (eq? mode 'quasiquote)
|
|
(if (= depth 1)
|
|
(expand-type #'T env)
|
|
(wrap #`(List #,(wrap-quote #'unquote)
|
|
#,(expand-quasiquote mode (- depth 1) env
|
|
#'T))))
|
|
(wrap #`(List #,(wrap-quote #'unquote)
|
|
#,(expand-quasiquote-rec #'T))))]
|
|
[((~literal syntax) T)
|
|
(wrap #`(List #,(wrap-quote #'quote)
|
|
#,(expand-quasiquote-rec #'T)))]
|
|
[((~literal quasisyntax) T)
|
|
(wrap #`(List #,(wrap-quote #'quasisyntax)
|
|
#,(if (eq? mode 'quasisyntax)
|
|
(expand-quasiquote mode (+ depth 1) env #'T)
|
|
(expand-quasiquote-rec #'T))))]
|
|
[((~literal unsyntax) T)
|
|
(if (eq? mode 'quasisyntax)
|
|
(if (= depth 1)
|
|
(expand-type #'T env)
|
|
(wrap #`(List #,(wrap-quote #'unsyntax)
|
|
#,(expand-quasiquote mode (- depth 1) env
|
|
#'T))))
|
|
(wrap #`(List #,(wrap-quote #'unsyntax)
|
|
#,(expand-quasiquote-rec #'T))))]
|
|
;; TODO For lists, we should consider the cases where syntax-e gives
|
|
;; a pair vs the cases where it gives a list.
|
|
[(T . U)
|
|
#:when (syntax? (cdr (syntax-e stx)))
|
|
(wrap #`(Pairof #,(expand-quasiquote-rec #'T)
|
|
#,(expand-quasiquote-rec #'U)))]
|
|
[() (wrap #'Null)]
|
|
[(T ...)
|
|
(wrap #`(List #,@(stx-map expand-quasiquote-rec #'(T ...))))]
|
|
[(T ... U . S)
|
|
(wrap #`(List* #,@(stx-map expand-quasiquote-rec #'(T ... U S))))]
|
|
[#(T ...)
|
|
(wrap #`(Vector #,@(stx-map expand-quasiquote-rec #'(T ...))))]
|
|
[#&T (wrap #`(Boxof #,(expand-quasiquote-rec #'T)))]
|
|
; TODO: Prefab with #s(prefab-struct-key type ...)
|
|
[T:id (wrap #''T)]
|
|
[T #:when (string? (syntax-e #'T)) (wrap #'T)]
|
|
[T:number (wrap #'T)]
|
|
[T:keyword (wrap #''T)]
|
|
[T:char (wrap #'T)]
|
|
[#t (wrap #'True)]
|
|
[#t (wrap #'False)]
|
|
[_ (raise-syntax-error 'expand-quasiquote
|
|
(format "Unknown quasiquote contents: ~a" stx)
|
|
stx)]))]
|
|
|
|
@section{Overloading @racket[typed/racket] forms}
|
|
|
|
Througout this section, we provide alternative definitions of the
|
|
@tc[typed/racket] forms @tc[:], @tc[lambda], @tc[define], @tc[struct], @tc[ann],
|
|
@tc[inst]… . We write these definitions with @tc[syntax-parse], using the syntax
|
|
classes defined in section @secref{type-expander|syntax-classes}.
|
|
|
|
Most of the time, we will use the experimental @tc[template] macro from
|
|
@tc[syntax/parse/experimental/template] which allows more concise code than the
|
|
ususal @code{#'()} and @code{#`()}. In order to expand types and bind type
|
|
variables in the result, we define two template metafunctions:
|
|
|
|
@chunk[<template-metafunctions>
|
|
(define-template-metafunction (tmpl-expand-type stx)
|
|
(syntax-parse stx
|
|
[(_ () t) (expand-type #'t)]
|
|
[(_ (tvar …) t) (expand-type #'t (bind-type-vars #'(tvar …)))]))]
|
|
|
|
@subsection{@racket[:]}
|
|
|
|
We provide a new definition for the @tc[:] operator, which calls the old one
|
|
after expanding the type argument.
|
|
|
|
@CHUNK[<:>
|
|
(define-syntax/parse (new-: x:id t:expr)
|
|
#`(: x #,(expand-type #'t)))]
|
|
|
|
@subsection[#:tag "type-expander|syntax-classes"]{syntax classes}
|
|
|
|
The syntax classes from @tc[typed-racket/base-env/annotate-classes] match
|
|
against the @tc[:] literal. Since we provide a new definition for it, the syntax
|
|
class doesn't match code using our definition of @tc[:]. We therefore can't use
|
|
the original implementations of @tc[:curried-formals] and @tc[lambda-formals],
|
|
and instead have to roll out our own versions.
|
|
|
|
We take that as an opportunity to expand the types directly from the syntax
|
|
classes using @tc[#:with], instead of doing that inside the macros that use
|
|
them.
|
|
|
|
@CHUNK[<syntax-classes>
|
|
(define-syntax-class colon
|
|
(pattern (~or (~literal new-:) (~literal :))))
|
|
|
|
(define-splicing-syntax-class (new-maybe-kw-type-vars)
|
|
#:attributes (vars maybe)
|
|
(pattern kw+vars:lambda-type-vars
|
|
#:with vars #'kw+vars.type-vars
|
|
#:with maybe #'kw+vars)
|
|
(pattern (~seq)
|
|
#:with vars #'()
|
|
#:attr maybe #f))
|
|
|
|
(define-splicing-syntax-class (new-maybe-type-vars)
|
|
#:attributes (vars maybe)
|
|
(pattern vars:type-variables
|
|
#:with maybe #'vars)
|
|
(pattern (~seq)
|
|
#:with vars #'()
|
|
#:attr maybe #f))
|
|
|
|
(define-splicing-syntax-class (new-kw-formal tvars)
|
|
#:attributes ([expanded 1])
|
|
(pattern (~seq kw:keyword id:id)
|
|
#:with (expanded ...) #'(kw id))
|
|
(pattern (~seq kw:keyword [id:id
|
|
(~optional (~seq :colon type:expr))
|
|
(~optional default:expr)])
|
|
#:with tvars tvars
|
|
#:with (expanded ...)
|
|
(template (kw [id (?@ : (tmpl-expand-type tvars type))
|
|
(?? default)]))))
|
|
|
|
(define-splicing-syntax-class (new-mand-formal tvars)
|
|
#:attributes ([expanded 1])
|
|
(pattern id:id
|
|
#:with (expanded ...) #'(id))
|
|
(pattern [id:id :colon type:expr]
|
|
#:with tvars tvars
|
|
#:with (expanded ...)
|
|
(template ([id : (tmpl-expand-type tvars type)])))
|
|
(pattern (~var kw (new-kw-formal tvars))
|
|
#:with (expanded ...) #'(kw.expanded ...)))
|
|
|
|
(define-splicing-syntax-class (new-opt-formal tvars)
|
|
#:attributes ([expanded 1])
|
|
(pattern [id:id (~optional (~seq :colon type:expr)) default:expr]
|
|
#:with tvars tvars
|
|
#:with (expanded ...)
|
|
(template ([id (?? (?@ : (tmpl-expand-type tvars type)))
|
|
default])))
|
|
(pattern (~var kw (new-kw-formal tvars))
|
|
#:with (expanded ...) #'(kw.expanded ...)))
|
|
|
|
(define-syntax-class (new-rest-arg tvars)
|
|
#:attributes ([expanded 0])
|
|
(pattern rest:id
|
|
#:with expanded #'rest)
|
|
(pattern (rest:id
|
|
:colon type:expr
|
|
(~or (~and x* (~describe "*" (~or (~datum *) (~datum ...*))))
|
|
(~seq (~datum ...) bound:expr)))
|
|
#:with tvars tvars
|
|
#:with expanded
|
|
(template (rest : (tmpl-expand-type tvars type)
|
|
(?? x* (?@ (... ...) (tmpl-expand-type
|
|
tvars bound)))))))
|
|
|
|
(define-syntax-class (new-lambda-formals tvars)
|
|
(pattern (~or ((~var mand (new-mand-formal tvars)) ...
|
|
(~var opt (new-opt-formal tvars)) ...
|
|
. (~var rest (new-rest-arg tvars)))
|
|
((~var mand (new-mand-formal tvars)) ...
|
|
(~var opt (new-opt-formal tvars)) ...))
|
|
;; TODO: once template supports ?? in tail position, use it.
|
|
#:with expanded #`(mand.expanded ...
|
|
...
|
|
opt.expanded ...
|
|
...
|
|
. #,(if (attribute rest)
|
|
#'rest.expanded
|
|
#'()))))
|
|
|
|
(define-syntax-class (new-curried-formals tvars)
|
|
(pattern (f:id . (~var args (new-lambda-formals tvars)))
|
|
#:with expanded #'(f . args.expanded))
|
|
(pattern ((~var lhs (new-curried-formals tvars))
|
|
. (~var args (new-lambda-formals tvars)))
|
|
#:with expanded #'(lhs.expanded . args.expanded)))
|
|
|
|
(define-splicing-syntax-class (new-optionally-annotated-name tvars)
|
|
(pattern (~seq name:id (~optional (~seq :colon type:expr)))
|
|
#:with tvars tvars
|
|
#:with expanded
|
|
(template (name
|
|
(?? (?@ : (tmpl-expand-type tvars type)))))))
|
|
|
|
(define-syntax-class (new-name-or-parenthesised-annotated-name tvars)
|
|
(pattern name:id
|
|
#:with expanded #'name)
|
|
(pattern [id:id :colon type:expr]
|
|
#:with tvars tvars
|
|
#:with expanded
|
|
(template [id : (tmpl-expand-type tvars type)])))]
|
|
|
|
@subsection{@racket[define-type]}
|
|
|
|
@chunk[<define-type>
|
|
(define-syntax (new-define-type stx)
|
|
(syntax-parse stx
|
|
[(_ (~or name:id (name:id TVar ...)) type . rest)
|
|
(template
|
|
(define-type (?? (name TVar ...) name)
|
|
(tmpl-expand-type (?? (TVar ...) ()) type)
|
|
. rest))]))]
|
|
|
|
@subsection{@racket[define]}
|
|
|
|
@chunk[<define>
|
|
(define-syntax (new-define stx)
|
|
(syntax-parse stx
|
|
[(_ tvars:new-maybe-kw-type-vars
|
|
(~or v:id
|
|
(~var formals (new-curried-formals #'tvars.vars)))
|
|
(~optional (~seq :colon type))
|
|
e ...)
|
|
(template
|
|
(define (?@ . tvars) (?? v formals.expanded)
|
|
(?? (?@ : (tmpl-expand-type tvars.vars type)))
|
|
e ...))]))]
|
|
|
|
@subsection{@racket[lambda]}
|
|
|
|
@CHUNK[<lambda>
|
|
(define-syntax (new-lambda stx)
|
|
(syntax-parse stx
|
|
[(_ tvars:new-maybe-kw-type-vars
|
|
(~var args (new-lambda-formals #'tvars.vars))
|
|
(~optional (~seq :colon ret-type))
|
|
e ...)
|
|
(template (lambda (?@ . tvars) args.expanded
|
|
(?? (?@ : (tmpl-expand-type tvars.vars ret-type)))
|
|
e ...))]))]
|
|
|
|
@subsection{@racket[struct]}
|
|
|
|
@chunk[<struct>
|
|
(define-syntax (new-struct stx)
|
|
(syntax-parse stx
|
|
[(_ tvars:new-maybe-type-vars
|
|
(~and (~seq name+parent …) (~or (~seq name:id)
|
|
(~seq name:id parent:id)))
|
|
([field:id :colon type:expr] ...)
|
|
. rest)
|
|
(template (struct (?? tvars.maybe) name (?? parent)
|
|
([field : (tmpl-expand-type tvars.vars type)] ...)
|
|
. rest))]))]
|
|
|
|
@subsection{@racket[define-struct/exec]}
|
|
|
|
@chunk[<define-struct/exec>
|
|
(define-syntax (new-define-struct/exec stx)
|
|
(syntax-parse stx
|
|
[(_ (~and name+parent (~or name:id [name:id parent:id]))
|
|
([field:id (~maybe :colon type:expr)] ...)
|
|
[proc :colon proc-type])
|
|
(template (define-struct/exec name+parent
|
|
([field (?? (?@ : (tmpl-expand-type () type)))] ...)
|
|
[proc : (tmpl-expand-type () proc-type)]))]))]
|
|
|
|
@subsection{@racket[ann]}
|
|
|
|
@chunk[<ann>
|
|
(define-syntax/parse (new-ann value:expr (~optional :colon) type:expr)
|
|
(template (ann value (tmpl-expand-type () type))))]
|
|
|
|
@subsection{@racket[inst]}
|
|
|
|
@chunk[<inst>
|
|
(define-syntax/parse (new-inst v
|
|
(~optional :colon) t ...
|
|
(~optional (~seq last (~datum ...) b:id)))
|
|
(template (inst v (tmpl-expand-type () t) ...
|
|
(?? (?@ (tmpl-expand-type () last)
|
|
(... ...) b)))))]
|
|
|
|
@subsection{@racket[let]}
|
|
|
|
@chunk[<let>
|
|
(define-syntax/parse
|
|
(new-let
|
|
(~optional (~seq loop:id (~optional (~seq :colon return-type:expr))))
|
|
tvars:new-maybe-kw-type-vars
|
|
([(~var name (new-optionally-annotated-name #'tvars.vars))
|
|
e:expr] ...)
|
|
. rest)
|
|
(template
|
|
(let (?? (?@ loop (?? (?@ : (tmpl-expand-type tvars.vars
|
|
return-type)))))
|
|
(?@ . tvars)
|
|
([(?@ . name.expanded) e] ...)
|
|
. rest)))]
|
|
|
|
@subsection{@racket[let*]}
|
|
|
|
@chunk[<let*>
|
|
(define-syntax/parse
|
|
(new-let*
|
|
([(~var name (new-optionally-annotated-name #'()))
|
|
e:expr] ...)
|
|
. rest)
|
|
(template
|
|
(let* ([(?@ . name.expanded) e] ...)
|
|
. rest)))]
|
|
|
|
@subsection{@racket[let-values]}
|
|
|
|
@chunk[<let-values>
|
|
(define-syntax/parse
|
|
(new-let-values
|
|
([((~var name (new-name-or-parenthesised-annotated-name #'())) ...)
|
|
e:expr] ...)
|
|
. rest)
|
|
(template
|
|
(let-values ([(name.expanded ...) e] ...)
|
|
. rest)))]
|
|
|
|
@subsection{@racket[make-predicate]}
|
|
|
|
@chunk[<make-predicate>
|
|
(define-syntax/parse (new-make-predicate type:expr)
|
|
(template (make-predicate (tmpl-expand-type () type))))]
|
|
|
|
@subsection[#:tag "type-expander|other-forms"]{Other @racket[typed/racket]
|
|
forms}
|
|
|
|
The other @tc[typed/racket] forms below do not have an alternative definition
|
|
yet.
|
|
|
|
@chunk[<other-forms>
|
|
(define-syntax (missing-forms stx)
|
|
(syntax-parse stx
|
|
[(_ name ...)
|
|
(define/with-syntax (tmp ...) (generate-temporaries #'(name ...)))
|
|
#'(begin
|
|
(begin
|
|
(define-syntax (tmp stx)
|
|
(raise-syntax-error
|
|
'name
|
|
(format "~a not implemented yet for type-expander" 'name)))
|
|
(provide (rename-out [tmp name])))
|
|
...)]))
|
|
|
|
(missing-forms
|
|
;; TODO: add all-defined-out in prims.rkt
|
|
;; top-interaction.rkt
|
|
:type
|
|
:print-type
|
|
:query-type/args
|
|
:query-type/result
|
|
;; case-lambda.rkt
|
|
case-lambda
|
|
case-lambda:
|
|
pcase-lambda:
|
|
;; (submod "prims-contract.rkt" forms)
|
|
require/opaque-type
|
|
require-typed-struct-legacy
|
|
require-typed-struct
|
|
require/typed-legacy
|
|
require/typed
|
|
require/typed/provide
|
|
require-typed-struct/provide
|
|
cast
|
|
;make-predicate
|
|
define-predicate
|
|
;; prims.rkt
|
|
define-type-alias
|
|
define-new-subtype
|
|
define-typed-struct
|
|
define-typed-struct/exec
|
|
;ann
|
|
;inst
|
|
;:
|
|
define-struct:
|
|
define-struct
|
|
;struct
|
|
struct:
|
|
λ:
|
|
;lamdba
|
|
;λ
|
|
;define
|
|
;let
|
|
;let*
|
|
letrec
|
|
;let-values
|
|
letrec-values
|
|
let/cc
|
|
let/ec
|
|
let:
|
|
let*:
|
|
letrec:
|
|
let-values:
|
|
letrec-values:
|
|
let/cc:
|
|
let/ec:
|
|
for
|
|
for/list
|
|
for/vector
|
|
for/hash
|
|
for/hasheq
|
|
for/hasheqv
|
|
for/and
|
|
for/or
|
|
for/sum
|
|
for/product
|
|
for/lists
|
|
for/first
|
|
for/last
|
|
for/fold
|
|
for*
|
|
for*/list
|
|
for*/lists
|
|
for*/vector
|
|
for*/hash
|
|
for*/hasheq
|
|
for*/hasheqv
|
|
for*/and
|
|
for*/or
|
|
for*/sum
|
|
for*/product
|
|
for*/first
|
|
for*/last
|
|
for*/fold
|
|
for/set
|
|
for*/set
|
|
do
|
|
do:
|
|
with-handlers
|
|
define-struct/exec:
|
|
#|define-struct/exec|#)]
|
|
|
|
@section{Future work}
|
|
|
|
We have not implemented alternative type-expanding definitions for all the
|
|
@tc[typed/racket] forms, as noted in @secref{type-expander|other-forms}.
|
|
|
|
Integrating the type-expander directly into typed/racket would avoid the need to
|
|
provide such definitions, and allow using type-expanders in vanilla
|
|
@tc[typed/racket], instead of having to @tc[require] this library. However, the
|
|
code wrapping the @tc[typed/racket] forms could be re-used by other libraries
|
|
that alter the way @tc[typed/racket] works, so implementing the remaining forms
|
|
could still be useful.
|
|
|
|
Also, we would need to provide a @tc[syntax-local-type-introduce] function,
|
|
similar to the @tc[syntax-local-match-introduce] function provided by @tc[match]
|
|
for example.
|
|
|
|
@section{Conclusion}
|
|
|
|
When an identifier is @tc[require]d from another module, it is not the same as
|
|
the one visible within the defining module. This is a problem for @tc[:],
|
|
because we match against it in our syntax classes, using @tc[(~literal :)], but
|
|
when it is written in another module, for example @tc[(define foo : Number 42)],
|
|
it is not the same identifier as the one used by original definition of @tc[:],
|
|
and therefore the @tc[(~literal :)] won't match. I suspect that issue to be due
|
|
to contract wrappers added by @tc[typed/racket].
|
|
|
|
To get around that problem, we define @tc[:] in a separate module, and
|
|
@tc[require] it in the module containing the syntax classes:
|
|
|
|
@chunk[<module-colon>
|
|
(module colon typed/racket
|
|
(require (for-syntax racket
|
|
syntax/parse)
|
|
phc-toolkit)
|
|
(require (for-syntax (submod ".." expander)))
|
|
|
|
(provide new-:)
|
|
|
|
<:>)]
|
|
|
|
Since our @tc[new-:] macro needs to call the @tc[type-expander], and the other
|
|
forms too, we can't define @tc[type-expander] in the same module as these forms,
|
|
it needs to be either in the same module as @tc[new-:], or in a separate module.
|
|
Additionally, @tc[expand-type] needs to be required @tc[for-syntax] by the
|
|
forms, but needs to be @tc[provide]d too, so it is much easier if it is defined
|
|
in a separate module (that will be used only by macros, so it will be written in
|
|
@tc[racket], not @tc[typed/racket]).
|
|
|
|
@chunk[<module-expander>
|
|
(module expander racket
|
|
(require racket
|
|
syntax/parse
|
|
racket/format
|
|
syntax/id-table
|
|
(submod phc-toolkit untyped))
|
|
|
|
(require (for-template typed/racket))
|
|
|
|
(provide prop:type-expander
|
|
type-expander
|
|
apply-type-expander
|
|
bind-type-vars
|
|
expand-type)
|
|
|
|
<prop-guard>
|
|
<prop:type-expander>
|
|
<type-expander-struct>
|
|
|
|
<apply-type-expander>
|
|
<expand-quasiquote>
|
|
<bind-type-vars>
|
|
<let-type-todo>
|
|
<expand-type>)]
|
|
|
|
We can finally define the overloaded forms, as well as the extra
|
|
@tc[<define-type-expander>].
|
|
|
|
@chunk[<module-main>
|
|
(module main typed/racket
|
|
(require (for-syntax racket
|
|
racket/syntax
|
|
syntax/parse
|
|
syntax/parse/experimental/template
|
|
(submod phc-toolkit untyped))
|
|
phc-toolkit)
|
|
|
|
(require (submod ".." expander))
|
|
(require (for-syntax (submod ".." expander)))
|
|
(require (for-syntax typed-racket/base-env/annotate-classes))
|
|
(require (submod ".." colon))
|
|
|
|
(provide prop:type-expander
|
|
expand-type
|
|
define-type-expander
|
|
(rename-out [new-: :]
|
|
[new-define-type define-type]
|
|
[new-define define]
|
|
[new-lambda lambda]
|
|
[new-lambda λ]
|
|
[new-struct struct]
|
|
[new-define-struct/exec define-struct/exec]
|
|
[new-ann ann]
|
|
[new-inst inst]
|
|
[new-let let]
|
|
[new-let* let*]
|
|
[new-let-values let-values]
|
|
[new-make-predicate make-predicate]))
|
|
|
|
<define-type-expander>
|
|
|
|
(begin-for-syntax
|
|
<template-metafunctions>
|
|
<syntax-classes>
|
|
|
|
(provide colon))
|
|
|
|
<define-type>
|
|
<define>
|
|
<lambda>
|
|
<struct>
|
|
<define-struct/exec>
|
|
<ann>
|
|
<inst>
|
|
<let>
|
|
<let*>
|
|
<let-values>
|
|
<make-predicate>
|
|
<other-forms>)]
|
|
|
|
We can now assemble the modules in this order:
|
|
|
|
@chunk[<*>
|
|
(begin
|
|
<module-expander>
|
|
<module-colon>
|
|
<module-main>
|
|
|
|
(require 'main)
|
|
(provide (all-from-out 'main)))]
|