more-expanders.hl.rkt (11476B)
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[<quotes> 68 (patch-type-expander quote 69 (λ (stx) 70 (syntax-case stx () 71 [(_ T) 72 (expand-quasiquote 'quote 1 #'T)])))] 73 74 @chunk[<quotes> 75 (patch-type-expander quasiquote 76 (λ (stx) 77 (syntax-case stx () 78 [(_ T) 79 (expand-quasiquote 'quasiquote 1 #'T)])))] 80 81 @chunk[<quotes> 82 (patch-type-expander syntax 83 (λ (stx) 84 (syntax-case stx () 85 [(_ T) 86 (expand-quasiquote 'syntax 1 #'T)])))] 87 88 @chunk[<quotes> 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[<expand-quasiquote> 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[<Let*> 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[<curry> 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 <Let*> 258 259 (begin-for-syntax <expand-quasiquote>) 260 <quotes> 261 262 <curry>]