multi-id.hl.rkt (16564B)
1 #lang hyper-literate racket/base #:no-require-lang #:no-auto-require 2 @(require scribble-enhanced/doc 3 racket/require 4 (for-label (subtract-in typed/racket/base type-expander) 5 type-expander 6 phc-toolkit 7 (subtract-in racket/syntax phc-toolkit) 8 phc-toolkit/untyped-only 9 syntax/parse 10 syntax/parse/experimental/template 11 (only-in type-expander prop:type-expander))) 12 @doc-lib-setup 13 14 @title[#:style manual-doc-style 15 #:tag "remember" 16 #:tag-prefix "(lib multi-id/multi-id.hl.rkt)" 17 ]{Implementation of the 18 @racket[multi-id] library} 19 20 @(chunks-toc-prefix 21 '("(lib multi-id/multi-id.hl.rkt)")) 22 23 @author[@author+email["Suzanne Soy" "racket@suzanne.soy"]] 24 25 This document describes the implementation of the 26 @racketmodname[multi-id] library, using literate 27 programming. For the library's documentation, see the 28 @other-doc['(lib "multi-id/scribblings/multi-id.scrbl")] 29 document instead. 30 31 @section{Syntax properties implemented by the defined @racket[multi-id]} 32 33 @chunk[#:save-as prop-te <props> 34 (?? (?@ #:property prop:type-expander p-type))] 35 36 @chunk[#:save-as prop-me <props> 37 (?? (?@ #:property prop:match-expander p-match)) 38 (?? (?@ #:property prop:match-expander 39 (λ (stx) (syntax-case stx () 40 [(_ . rest) #'(p-match-id . rest)]))))] 41 42 @chunk[#:save-as prop-cw <props> 43 (?? (?@ #:property prop:custom-write p-write))] 44 45 @chunk[#:save-as prop-set! <props> 46 #:property prop:set!-transformer 47 (?? p-set! 48 (λ (_ stx) 49 (syntax-case stx (set!) 50 [(set! self . rest) (?? p-set! <fail-set!>)] 51 (?? [(_ . rest) p-just-call]) 52 (?? [_ p-just-id]))))] 53 54 @chunk[#:save-as maybe-define-type-noexpand <maybe-define-type> 55 (?? (tr:define-type name p-type-noexpand #:omit-define-syntaxes))] 56 57 @chunk[#:save-as maybe-define-type-expand-once <maybe-define-type> 58 (?? (define-type name p-type-expand-once #:omit-define-syntaxes))] 59 60 @chunk[#:save-as prop-fallback <props> 61 (?@ #:property fallback.prop fallback-value) 62 …] 63 64 @(module orig racket/base 65 (require scribble/manual 66 (for-label typed/racket/base)) 67 (define orig:tr:define-type @racket[define-type]) 68 (provide orig:tr:define-type)) 69 @(require 'orig) 70 71 The multi-id macro defines the identifier @tc[_name] as a 72 struct with several properties: 73 @itemlist[ 74 @item{@racket[prop:type-expander], so that the identifier 75 acts as a 76 @tech[#:doc '(lib "type-expander/scribblings/type-expander.scrbl")]{ 77 type expander} 78 79 @(prop-te) 80 81 Optionally, the user can request the type to not be 82 expanded, in which case we bind the type expression to a 83 temporary type name, using the original 84 @orig:tr:define-type from @racketmodname[typed/racket]: 85 86 @(maybe-define-type-noexpand) 87 88 The user can otherwise request that the type expression be 89 expanded once and for all. This can be used for 90 performance reasons, to cache the expanded type, instead 91 of re-computing it each time the @racket[name] identifier 92 is used as a type. To achieve that, we bind the expanded 93 type to a temporary type name using @racket[define-type] 94 as provided by the @racketmodname[type-expander] library: 95 96 @(maybe-define-type-expand-once) 97 98 The two keywords @racket[#:type-noexpand] and 99 @racket[#:type-expand-once] can also be used to circumvent 100 issues with recursive types (the type expander would 101 otherwise go in an infinite loop while attempting to 102 expand them). This behaviour may be fixed in the future, 103 but these options should stay so that they can still be 104 used for performance reasons.} 105 106 @item{@racket[prop:match-expander], so that the identifier 107 acts as a 108 @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{ 109 match expander} 110 111 @(prop-me)} 112 113 @item{@racket[prop:custom-write], so that the identifier 114 can be printed in a special way. Note that this does not 115 affect instances of the data structure defined using 116 multi-id. It is even possible that this property has no 117 effect, as no instances of the structure should ever be 118 created, in practice. This feature is therefore likely to 119 change in the future. 120 121 @(prop-cw)} 122 123 @item{@racket[prop:set!-transformer], so that the 124 identifier can act as a regular 125 @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{macro}, 126 as an 127 @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{identifier macro} 128 and as a 129 @seclink["set__Transformers" #:doc '(lib "scribblings/guide/guide.scrbl")]{ 130 set! transformer}. 131 132 @(prop-set!)} 133 134 @item{Any @racket[prop:xxx] identifier can be defined with @racket[#:xxx], if 135 so long as the @racket[prop:xxx] identifier is a 136 @racket[struct-type-property?]. 137 138 @(prop-fallback)}] 139 140 The multi-id macro therefore defines @racket[_name] as follows: 141 142 @chunk[<multi-id-body> 143 (template 144 (begin 145 <maybe-define-type> 146 (define-syntax name 147 (let () 148 (struct tmp () 149 <props>) 150 (tmp)))))] 151 152 @section{Signature of the @racket[multi-id] macro} 153 154 155 @chunk[#:save-as type-expander-kws <type-expander-kws> 156 (~optional (~or (~seq #:type-expander p-type:expr) 157 (~seq #:type-noexpand p-type-noexpand:expr) 158 (~seq #:type-expand-once p-type-expand-once:expr)))] 159 160 @chunk[#:save-as match-expander-kws <match-expander-kws> 161 (~optional (~or (~seq #:match-expander p-match:expr) 162 (~seq #:match-expander-id p-match-id:id)))] 163 164 @chunk[#:save-as custom-write-kw <custom-write-kw> 165 (~optional (~seq #:custom-write p-write:expr))] 166 167 @chunk[#:save-as set!-transformer-kws <set!-transformer-kws> 168 (~optional (~or (~seq #:set!-transformer p-set!:expr) 169 :kw-else 170 :kw-set!+call+id))] 171 172 @; TODO: maybe we should cache @tc[p-else] and @tc[p-get]. 173 174 @CHUNK[#:save-as stx-class-kw-else <stx-class-kw-else> 175 (define-splicing-syntax-class kw-else 176 #:attributes (p-just-set! p-just-call p-just-id) 177 (pattern (~seq #:mutable-else p-else) 178 #:with p-just-set! #'#'(set! p-else . rest) 179 #:with p-just-call #'#'(p-else . rest) 180 #:with p-just-id #'#'p-else) 181 (pattern (~seq #:else p-else) 182 #:with p-just-set! <fail-set!> 183 #:with p-just-call #'#`(#,p-else . rest) 184 #:with p-just-id #'p-else) 185 (pattern (~seq #:mutable-else-id p-else-id) 186 #:with (:kw-else) #'(#:mutable-else #'p-else-id)) 187 (pattern (~seq #:else-id p-else-id) 188 #:with (:kw-else) #'(#:else #'p-else-id)))] 189 190 @; TODO: add #:pattern-expander with prop:pattern-expander, see 191 @; http://docs.racket-lang.org/syntax/stxparse-patterns.html 192 @; #%28def._%28%28lib._syntax%2Fparse..rkt%29._prop~3apattern-expander%29%29 193 @chunk[#:save-as stx-class-kw-set!+call+id <stx-class-kw-set!+call+id> 194 (define-splicing-syntax-class kw-set!+call+id 195 (pattern (~seq (~or 196 (~optional (~seq #:set! p-user-set!:expr)) 197 (~optional (~or (~seq #:call p-user-call:expr) 198 (~seq #:call-id p-user-call-id:id))) 199 (~optional (~or (~seq #:id p-user-id:expr) 200 (~seq #:id-id p-user-id-id:expr)))) 201 …) 202 #:attr p-just-set! 203 (and (attribute p-user-set!) #'(p-user-set! stx)) 204 #:attr p-just-call 205 (cond [(attribute p-user-call) 206 #'(p-user-call stx)] 207 [(attribute p-user-call-id) 208 #'(syntax-case stx () 209 [(_ . rest) #'(p-user-call-id . rest)])] 210 [else #f]) 211 #:attr p-just-id 212 (cond [(attribute p-user-id) #'(p-user-id stx)] 213 [(attribute p-user-id-id) #'#'p-user-id-id] 214 [else #f])))] 215 216 @chunk[#:save-as fail-set! <fail-set!> 217 #'(raise-syntax-error 218 'self 219 (format "can't set ~a" (syntax->datum #'self)))] 220 @chunk[#:save-as prop-keyword <prop-keyword-syntax-class> 221 (define-syntax-class prop-keyword 222 (pattern keyword:keyword 223 #:with prop (datum->syntax #'keyword 224 (string->symbol 225 (string-append 226 "prop:" 227 (keyword->string 228 (syntax-e #'keyword)))) 229 #'keyword 230 #'keyword) 231 #:when (eval #'(struct-type-property? prop))))] 232 233 @chunk[#:save-as fallback-kw <fallback-kw> 234 (~seq fallback:prop-keyword fallback-value:expr)] 235 236 The @tc[multi-id] macros supports many options, although 237 not all combinations are legal. The groups of options 238 specify how the @racket[_name] identifier behaves as a type 239 expander, match expander, how it is printed with 240 @racket[prop:custom-write] and how it acts as a 241 @racket[prop:set!-transformer], which covers usage as a 242 macro, identifier macro and actual @racket[set!] 243 transformer. 244 245 @chunk[<multi-id> 246 (begin-for-syntax 247 <stx-class-kw-else> 248 <stx-class-kw-set!+call+id> 249 <prop-keyword-syntax-class>) 250 (define-syntax/parse (define-multi-id name:id 251 (~or <type-expander-kws> 252 <match-expander-kws> 253 <custom-write-kw> 254 <set!-transformer-kws> 255 <fallback-kw>) 256 …) 257 <multi-id-body>)] 258 259 These groups of options are detailed below: 260 261 @itemlist[ 262 @item{The @racket[#:type-expander], 263 @racket[#:type-noexpand] and @racket[#:type-expand-once] 264 options are mutually exclusive. 265 266 @(type-expander-kws)} 267 268 @item{The @racket[#:match-expander] and @racket[#:match-expander-id] 269 options are mutually exclusive. 270 271 @(match-expander-kws)} 272 273 @item{The @racket[#:custom-write] keyword can always be used 274 275 @(custom-write-kw)} 276 277 @item{The @racket[prop:set!-transformer] can be specified 278 as a whole using @racket[#:set!-transformer], or using one 279 of @racket[#:else], @racket[#:else-id], 280 @racket[#:mutable-else] or @racket[#:mutable-else-id], or 281 using some combination of @racket[#:set!], 282 @racket[#:call] (or @racket[#:call-id]) and 283 @racket[#:id]. 284 285 @(set!-transformer-kws) 286 287 More precisely, the @racket[kw-else] syntax class accepts 288 one of the mutually exclusive options @racket[#:else], 289 @racket[#:else-id], @racket[#:mutable-else] and 290 @racket[#:mutable-else-id]: 291 292 @(stx-class-kw-else) 293 294 The @racket[kw-set!+call+id] syntax class accepts 295 optionally the @racket[#:set!] keyword, optionally one of 296 @racket[#:call] or @racket[#:call-id], and optionally the 297 @racket[#:id] keyword. 298 299 @(stx-class-kw-set!+call+id) 300 301 When neither the @racket[#:set!] option nor 302 @racket[#:set!-transformer] are given, the @racket[_name] 303 identifier acts as an immutable object, and 304 cannot be used in a @racket[set!] form. If it appears as 305 the second element of a @racket[set!] form, it raises a 306 syntax error: 307 308 @(fail-set!)} 309 310 @item{As a fallback, for any @racket[#:xxx] keyword, we check whether a 311 corresponding @racket[prop:xxx] exists, and whether it is a 312 @racket[struct-type-property?]: 313 314 @(fallback-kw) 315 316 The check is implemented as a syntax class: 317 318 @(prop-keyword)}] 319 320 @section{Tests for @racket[multi-id]} 321 322 @chunk[<test-multi-id> 323 (define (p1 [x : Number]) (+ x 1)) 324 325 (define-type-expander (Repeat stx) 326 (syntax-case stx () 327 [(_ t n) #`(List #,@(map (λ (x) #'t) 328 (range (syntax->datum #'n))))])) 329 330 (define-multi-id foo 331 #:type-expander 332 (λ (stx) #'(List (Repeat Number 3) 'x)) 333 #:match-expander 334 (λ (stx) #'(vector _ _ _)) 335 #:custom-write 336 (λ (self port mode) (display "custom-write for foo" port)) 337 #:set!-transformer 338 (λ (_ stx) 339 (syntax-case stx (set!) 340 [(set! self . _) 341 (raise-syntax-error 'foo (format "can't set ~a" 342 (syntax->datum #'self)))] 343 [(_ . rest) #'(+ . rest)] 344 [_ #'p1]))) 345 346 (check-equal? (ann (ann '((1 2 3) x) foo) 347 (List (List Number Number Number) 'x)) 348 '((1 2 3) x)) 349 350 (code:comment "(set! foo 'bad) should throw an error here") 351 352 (let ([test-match (λ (val) (match val [(foo) #t] [_ #f]))]) 353 (check-equal? (test-match #(1 2 3)) #t) 354 (check-equal? (test-match '(1 x)) #f)) 355 356 (check-equal? (foo 2 3) 5) 357 (check-equal? (map foo '(1 5 3 4 2)) '(2 6 4 5 3))] 358 359 It would be nice to test the @tc[(set! foo 'bad)] case, but grabbing the 360 compile-time error is a challenge (one could use @tc[eval], but it's a bit heavy 361 to configure). 362 363 Test with @tc[#:else]: 364 365 @chunk[<test-multi-id> 366 (begin-for-syntax 367 (define-values 368 (prop:awesome-property awesome-property? get-awesome-property) 369 (make-struct-type-property 'awesome-property))) 370 371 (define-multi-id bar-id 372 #:type-expander 373 (λ (stx) #'(List `,(Repeat 'x 2) Number)) 374 #:match-expander 375 (λ (stx) #'(cons _ _)) 376 #:custom-write 377 (λ (self port mode) (display "custom-write for foo" port)) 378 #:else-id p1 379 #:awesome-property 42) 380 381 (check-equal? (ann (ann '((x x) 79) bar) 382 (List (List 'x 'x) Number)) 383 '((x x) 79)) 384 385 (code:comment "(set! bar 'bad) should throw an error here") 386 387 (let ([test-match (λ (val) (match val [(bar-id) #t] [_ #f]))]) 388 (check-equal? (test-match '(a . b)) #t) 389 (check-equal? (test-match #(1 2 3)) #f)) 390 391 (let ([f-bar-id bar-id]) 392 (check-equal? (f-bar-id 6) 7)) 393 (check-equal? (bar-id 6) 7) 394 (check-equal? (map bar-id '(1 5 3 4 2)) '(2 6 4 5 3)) 395 396 (require (for-syntax rackunit)) 397 (define-syntax (check-awesome-property stx) 398 (syntax-case stx () 399 [(_ id val) 400 (begin (check-pred awesome-property? 401 (syntax-local-value #'id (λ _ #f))) 402 (check-equal? (get-awesome-property 403 (syntax-local-value #'id (λ _ #f))) 404 (syntax-e #'val)) 405 #'(void))])) 406 (check-awesome-property bar-id 42)] 407 408 @chunk[<test-multi-id> 409 (define-multi-id bar 410 #:type-expander 411 (λ (stx) #'(List `,(Repeat 'x 2) Number)) 412 #:match-expander 413 (λ (stx) #'(cons _ _)) 414 #:custom-write 415 (λ (self port mode) (display "custom-write for foo" port)) 416 #:else #'p1) 417 418 (check-equal? (ann (ann '((x x) 79) bar) 419 (List (List 'x 'x) Number)) 420 '((x x) 79)) 421 422 (code:comment "(set! bar 'bad) should throw an error here") 423 424 (let ([test-match (λ (val) (match val [(bar) #t] [_ #f]))]) 425 (check-equal? (test-match '(a . b)) #t) 426 (check-equal? (test-match #(1 2 3)) #f)) 427 428 (check-equal? (bar 6) 7) 429 (check-equal? (map bar '(1 5 3 4 2)) '(2 6 4 5 3))] 430 431 @section{Conclusion} 432 433 @chunk[<*> 434 (require (only-in type-expander prop:type-expander define-type) 435 (only-in typed/racket [define-type tr:define-type]) 436 phc-toolkit/untyped 437 (for-syntax phc-toolkit/untyped 438 racket/base 439 racket/syntax 440 syntax/parse 441 syntax/parse/experimental/template 442 (only-in type-expander prop:type-expander))) 443 (provide define-multi-id) 444 445 <multi-id> 446 447 (module* test-syntax racket/base 448 (provide tests) 449 (define tests #'(begin <test-multi-id>)))]