tagged.hl.rkt (28922B)
1 #lang hyper-literate typed/racket/base #:no-require-lang #:no-auto-require 2 @(require racket/require 3 scribble-enhanced/doc 4 scribble-math 5 hyper-literate 6 (for-label (lib "phc-adt/tagged-structure-low-level.hl.rkt") 7 (lib "phc-adt/node-low-level.hl.rkt") 8 extensible-parser-specifications 9 racket/format 10 phc-toolkit 11 phc-toolkit/untyped-only 12 remember 13 syntax/parse 14 (subtract-in typed/racket/base type-expander) 15 type-expander 16 multi-id)) 17 18 @(unless-preexpanding 19 (require (for-label (submod "..")))) 20 21 @doc-lib-setup 22 23 @title[#:style manual-doc-style 24 #:tag "tagged" 25 #:tag-prefix "phc-adt/tagged"]{User API for tagged structures} 26 27 @(chunks-toc-prefix 28 '("(lib phc-adt/scribblings/phc-adt-implementation.scrbl)" 29 "phc-adt/tagged")) 30 31 @(table-of-contents) 32 33 @section{Overview of the implementation of structures} 34 35 Tagged structures are represented using regular Racket @tc[struct]s, 36 see @secref["choices" #:tag-prefixes '("phc-adt/choices")] 37 for a somewhat outdated discussion of alternative possibilities. 38 39 The ADT type system implemented by this library needs to know about all declared 40 structures across the program, so that fields can be accessed anonymously, e.g. 41 @tc[(get _instance _f)] instead of the traditional @tc[(_s-f _instance)] (where 42 @tc[_s] is the struct's identifier, and @tc[f] is the field name). This allows 43 the accessor @racket[get] to work on all structures which contain a field with 44 the given name (and therefore plays well with 45 @seclink["Union_Types" #:doc '(lib "typed-racket/scribblings/ts-guide.scrbl")]{ 46 unions} of structures which share some fields). It also avoids the need to 47 specify the struct which declared a field in order to accessing it. A separate 48 library adds a coat of syntactic sugar to enable the notation 49 @racket[instance.f1.f2.f3], following the well-known convention often used by 50 object-oriented languages. 51 52 The section @secref["tagged-low-level" 53 #:tag-prefixes '("phc-adt/tagged-low-level")] 54 describes the low-level implementation of tagged structures, including how all 55 declared structures are remembered across compilations, and the implementation 56 of the basic operations on them: constructor, predicate, accessor, type, 57 match expander, and row polymorphism (also known as static duck typing). The 58 implementation of row polymorphism works by querying the list of all known 59 tagged structures and returns those containing a given set of fields. 60 61 @section{A polyvalent identifier: type, match, constructor and instance} 62 63 The @tc[tagged] identifier can be used to describe a tagged structure type, a 64 match pattern, a tagged structure builder function, or to directly create an 65 instance. The last two cases are handled by the @tc[<call-expander>]. 66 67 @chunk[<tagged> 68 (define-multi-id tagged 69 #:type-expander tagged-type-expander 70 #:match-expander tagged-match-expander 71 #:call tagged-call-expander)] 72 73 @section{The @racket[tagged] call expander (builder and instance)} 74 75 @chunk[#:save-as parse-field-instance… |<call [fieldᵢ] …+>| 76 (~seq {~either [fieldᵢ:id] fieldᵢ:id} …+ 77 {~global-or builder?} 78 {~global-or no-types?} 79 {~post-fail <no-values-error> #:when (attribute instance?)})] 80 81 @chunk[#:save-as parse-field… |<[fieldᵢ] …+>| 82 (~seq {~either [fieldᵢ:id] fieldᵢ:id} …+ 83 {~global-or no-types?})] 84 85 @chunk[#:save-as parse-field-colon-type… |<call [fieldᵢ : τᵢ] …+>| 86 (~seq [fieldᵢ:id C:colon τᵢ:expr] …+ 87 {~global-or builder?} 88 {~global-or types?} 89 {~post-fail <no-values-error> #:when (attribute instance?)})] 90 91 @chunk[#:save-as parse-field-type… |<[fieldᵢ τᵢ] …+>| 92 (~seq [fieldᵢ:id {~optional C:colon} τᵢ:expr] …+ 93 {~global-or types?})] 94 95 @chunk[#:save-as parse-field-pats… |<[fieldᵢ patᵢⱼ …] …+>| 96 (~seq (~either {~and fieldᵢ:id {~bind [(patᵢⱼ 1) (list)]}} 97 [fieldᵢ:id patᵢⱼ:expr …]) 98 …+)] 99 100 @chunk[#:save-as parse-field-value… |<call [fieldᵢ valueᵢ] …+>| 101 (~seq [fieldᵢ:id valueᵢ:expr] …+ 102 {~global-or instance?} 103 {~global-or no-types?} 104 {~post-fail <values-error> #:when (attribute builder?)})] 105 106 @chunk[#:save-as parse-field-value-type… |<call [fieldᵢ valueᵢ : τᵢ] …+>| 107 (~seq (~either [fieldᵢ:id valueᵢ:expr C:colon τᵢ:expr] 108 [fieldᵢ:id C:colon τᵢ:expr valueᵢ:expr]) 109 …+ 110 {~global-or instance?} 111 {~global-or types?} 112 {~post-fail <values-error> #:when (attribute builder?)})] 113 114 @chunk[#:save-as no-values-error <no-values-error> 115 (~a "The #:instance keyword implies the use of [field value]," 116 " [field : type value] or [field value : type].")] 117 118 @chunk[#:save-as values-error <values-error> 119 (~a "The #:builder keyword implies the use of [field], field" 120 " or [field : type].")] 121 122 @chunk[#:save-as empty-error <empty-err> 123 (~a "If no fields are specified, then either #:builder or #:instance" 124 " must be present")] 125 126 When called like a macro, @tc[tagged] accepts several syntaxes: 127 @itemlist[ 128 @item{@racket[(tagged name [fieldᵢ] …+)] or @racket[(tagged name fieldᵢ …+)], 129 which return a builder function which has a type argument @racket[τᵢ] 130 corresponding to each @racket[fieldᵢ]'s type. 131 132 @(parse-field-instance…) 133 134 This clause implies the creation of a builder function, so if 135 @racket[#:instance] is specified, the following error is raised: 136 137 @(no-values-error)} 138 @item{@racket[(tagged name [fieldᵢ valueᵢ] …+)], which returns an instance, 139 inferring the type of the fields 140 141 @(parse-field-colon-type…) 142 143 This clause implies the creation of an instance, so if @racket[#:builder] is 144 specified, the following error is raised: 145 146 @(values-error)} 147 @item{@racket[(tagged name [fieldᵢ : τᵢ] …+)], which returns a constructor with 148 the given types 149 150 @(parse-field-value…) 151 152 This clause implies the creation of a builder function, so if 153 @racket[#:instance] is specified, the following error is raised: 154 155 @(no-values-error)} 156 @item{@racket[(tagged name [fieldᵢ valueᵢ : τᵢ] …+)], which returns an instance 157 using the given types 158 159 @(parse-field-value-type…) 160 161 This clause implies the creation of an instance, so if @racket[#:builder] is 162 specified, the following error is raised: 163 164 @(values-error)}] 165 166 @subsection{Call to @racket[tagged] with no fields: 167 instance or constructor?} 168 169 A call to @tc[(tagged)] with no field is ambiguous: it could return a 170 constructor function for the structure with no fields, or an instance of that 171 structure. 172 173 @racketblock[(tagged)] 174 175 We tried to make a hybrid object using @tc[define-struct/exec] which would be an 176 instance of the structure with no fields, but could also be called as a function 177 (which would return itself). Unfortunately, this use case is not yet fully 178 supported by Typed/Racket: the instance cannot be annotated as a function type, 179 or passed as an argument to a higher-order function (Typed/Racket issue 180 @hyperlink["https://github.com/racket/typed-racket/issues/430"]{#430}). This can 181 be circumvented by using unsafe operations to give the instance its proper type 182 @tc[(Rec R (∩ (→ R) struct-type))], but Typed/Racket does not consider this type 183 applicable, and an annotation is required each time the instance is used as a 184 builder function (Typed/Racket issue 185 @hyperlink["https://github.com/racket/typed-racket/issues/431"]{#431}. 186 187 We therefore added two optional keywords, @tc[#:instance] and @tc[#:builder], 188 which can be used to disambiguate. They can also be used when fields 189 respectively with or without values are specified, so that macros don't need to 190 handle the empty structure as a special case. 191 192 @subsection{Signature for the @racket[tagged] call expander} 193 194 @chunk[#:save-as disambiguate-mixin <tagged-call-instance-or-builder-mixin> 195 (define-eh-alternative-mixin tagged-call-instance-or-builder-mixin 196 (pattern 197 (~optional (~and instance-or-builder 198 (~or {~global-or instance? #:instance} 199 {~global-or builder? #:builder})) 200 #:name "either #:instance or #:builder")))] 201 202 @chunk[#:save-as fields-mixin <tagged-call-fields-mixin> 203 (define-eh-alternative-mixin tagged-call-fields-mixin 204 (pattern 205 (~optional/else 206 (~try-after name-order-point <name-after-field-error> 207 (~or |<call [fieldᵢ] …+>| 208 |<call [fieldᵢ : τᵢ] …+>| 209 |<call [fieldᵢ valueᵢ] …+>| 210 |<call [fieldᵢ valueᵢ : τᵢ] …+>|)) 211 #:defaults ([(fieldᵢ 1) (list)] 212 [(valueᵢ 1) (list)] 213 [(τᵢ 1) (list)]) 214 #:else-post-fail <empty-err> #:unless (or (attribute builder?) 215 (attribute instance?)) 216 #:name (~a "field or [field] or [field : type] for #:builder," 217 " [field value] or [field : type value]" 218 " or [field value : type] for #:instance"))))] 219 220 @chunk[#:save-as ∀-mixin <∀-mixin> 221 (define-eh-alternative-mixin ∀-mixin 222 (pattern {~optional (~seq #:∀ ({~named-seq tvarᵢ :id …}) 223 (~global-or tvars?))}))] 224 225 @chunk[#:save-as name-id-mixin <name-id-mixin> 226 (define-eh-alternative-mixin name-id-mixin 227 (pattern 228 (~once (~order-point name-order-point name:id))))] 229 230 @chunk[#:save-as name-after-field-error <name-after-field-error> 231 "the name must appear before any field"] 232 233 When called as a macro, @tc[tagged] expects: 234 235 @itemlist[ 236 @item{The tagged structure's tag name: 237 238 @(name-id-mixin)} 239 @item{An optional list of type variables, preceded by @racket[#:∀]: 240 241 @(∀-mixin)} 242 @item{Either of the @racket[#:builder] or @racket[#:instance] options, or none: 243 244 @(disambiguate-mixin)} 245 @item{An optional list of fields, possibly annotated with a type, and possibly 246 associated to a value: 247 248 @(fields-mixin) 249 250 When no fields are specified, the following error is raised unless either 251 @racket[#:builder] or @racket[#:instance] is specified. 252 253 @(empty-error)}] 254 255 The four elements can appear in any order, with one constraint: the name must 256 appear before the first field descriptor. Not only does it make more sense 257 semantically, but it also avoids ambiguities when the list of field names is 258 just a list of plain identifiers (without any type or value). 259 260 @(name-after-field-error) 261 262 We can now combine all four mixins. 263 264 @chunk[<tagged-call-args-mixin> 265 (define-eh-alternative-mixin tagged-call-args-mixin 266 #:define-splicing-syntax-class tagged-call-args-syntax-class 267 (pattern {~mixin name-id-mixin}) 268 (pattern {~mixin tagged-call-instance-or-builder-mixin}) 269 (pattern {~mixin tagged-call-fields-mixin}) 270 (pattern {~mixin ∀-mixin}))] 271 272 @subsection{Implementation} 273 274 The call expander uses the low-level functions @tc[tagged-builder!], 275 @tc[tagged-∀-builder!] and @tc[tagged-infer-builder!] implemented in 276 @secref["Creating_instances_of_a_tagged_structure" 277 #:tag-prefixes '("phc-adt/tagged-low-level")]. 278 The first returns the syntax for a builder function for the given tagged 279 structure. The second returns the syntax for a polymorphic builder function for 280 the given tagged structure, using the given type variables which are bound 281 inside the field type declarations. The last returns the syntax for a 282 polymorphic builder function for the given tagged structure, with one type 283 parameter per field, which allows the type of each field to be inferred. 284 285 @chunk[<call-expander> 286 (define/syntax-parse+simple 287 (tagged-call-expander :tagged-call-args-syntax-class) 288 <call-expander-cases>)] 289 290 If type variables are present, then @tc[tagged-∀-builder!] is used. Otherwise, 291 if types are specified, then @tc[tagged-builder!] is used, otherwise 292 @tc[tagged-infer-builder!] is used. 293 294 @chunk[<call-expander-cases> 295 (define/with-syntax f 296 (if (attribute tvars?) 297 (tagged-∀-builder! #'((tvarᵢ …) name [fieldᵢ : τᵢ] …)) 298 (if (attribute types?) 299 (tagged-builder! #'(name [fieldᵢ τᵢ] …)) 300 (tagged-infer-builder! #'(name fieldᵢ …)))))] 301 302 If the @tc[#:instance] keyword was specified, or if values are specified for 303 each field, the builder function is immediately called with those values, in 304 order to produce an instance of the tagged structure. Otherwise, the builder 305 function itself is produced. 306 307 @chunk[<call-expander-cases> 308 (if (attribute instance?) 309 #'(f valueᵢ …) 310 #'f)] 311 312 @section{Type expander} 313 314 @chunk[#:save-as type-fields-mixin <tagged-type-fields-mixin> 315 (define-eh-alternative-mixin tagged-type-fields-mixin 316 (pattern 317 (~optional 318 (~try-after name-order-point <name-after-field-error> 319 (~named-seq field-declarations 320 (~or |<[fieldᵢ] …+>| 321 |<[fieldᵢ τᵢ] …+>|))) 322 #:defaults ([(fieldᵢ 1) (list)] 323 [(τᵢ 1) (list)]) 324 #:name "field or [field] or [field type] or [field : type]")))] 325 326 When used as a type expander, @tc[tagged] expects: 327 328 @itemlist[ 329 @item{The tagged structure's tag name, as defined for the call expander in 330 @racket[<name-id-mixin>]} 331 @item{An optional list of type variables, as defined for the call expander in 332 @racket[<∀-mixin>]} 333 @item{An optional list of fields, possibly annotated with a type: 334 335 @(type-fields-mixin) 336 337 The main difference with the allowed field specifications for the call 338 expander are that values are not allowed. Furthermore, the @racket[:] between 339 a field and its type is optional: 340 341 @(parse-field-type…) 342 343 Furthermore, the @racket[instance?] and @racket[builder?] attributes are not 344 meaningful for the type expander. 345 346 @(parse-field…)}] 347 348 The three elements can appear in any order, with the same constraint as for the 349 call expander: the name must appear before the first field descriptor. 350 351 @(name-after-field-error) 352 353 @chunk[<tagged-type-args-mixin> 354 (define-eh-alternative-mixin tagged-type-args-mixin 355 #:define-splicing-syntax-class tagged-type-args-syntax-class 356 (pattern {~mixin name-id-mixin}) 357 (pattern {~mixin tagged-type-fields-mixin}) 358 (pattern {~mixin ∀-mixin}))] 359 360 The type expander uses the low-level functions @tc[tagged-type!], 361 @tc[tagged-∀-type!] and @tc[tagged-infer-type!] implemented in 362 @secref["Type_of_a_tagged_structure" 363 #:tag-prefixes '("phc-adt/tagged-low-level")]. The first 364 returns the syntax for the type for the given tagged structure. The second 365 returns the syntax for a polymorphic type for the given tagged structure, using 366 the given type variables which are bound inside the field type declarations. The 367 last returns the syntax for a polymorphic type for the given tagged structure, 368 with one type parameter per field, which allows the type of each field to be 369 inferred or filled in later. 370 371 @chunk[<type-expander> 372 (define/syntax-parse+simple 373 (tagged-type-expander :tagged-type-args-syntax-class) 374 <type-expander-cases>)] 375 376 If type variables are present, then @tc[tagged-∀-type!] is used. Otherwise, 377 if types are specified, then @tc[tagged-type!] is used, otherwise 378 @tc[tagged-infer-type!] is used. 379 380 @chunk[<type-expander-cases> 381 (if (attribute tvars?) 382 (tagged-∀-type! #'((tvarᵢ …) name [fieldᵢ : τᵢ] …)) 383 (if (attribute types?) 384 (tagged-type! #'(name [fieldᵢ τᵢ] …)) 385 (tagged-infer-type! #'(name fieldᵢ …))))] 386 387 @subsection{The @racket[TaggedTop] type} 388 389 The @tc[TaggedTop] type is extracted from the low-level @tc[TaggedTop-struct] 390 identifier (which is a struct identifier). The @tc[TaggedTop] type includes not 391 only tagged structures, but also nodes. 392 393 @chunk[<TaggedTop> 394 (define-type TaggedTop TaggedTop-struct)] 395 396 Additionally, the @racket[TaggedTop?] predicate is simply aliased from the 397 low-level @racket[TaggedTop-struct?]. 398 399 @; Do not use rename-out, as it confuses scribble (two documentations for one 400 @; identifier: the user-level documentation of the TaggedTop? function, and 401 @; the low-level documentation of the TaggedTop-struct struct. 402 @chunk[<TaggedTop> 403 (define TaggedTop? TaggedTop-struct?)] 404 405 @section{Match expander} 406 407 @chunk[#:save-as match-fields-mixin <tagged-match-fields-mixin> 408 (define-eh-alternative-mixin tagged-match-fields-mixin 409 (pattern 410 (~maybe/empty 411 (~try-after name-order-point <name-after-field-error> 412 |<[fieldᵢ patᵢⱼ …] …+>|) 413 #:name (~a "field or [field pat …]"))))] 414 415 @chunk[#:save-as no-implicit-mixin <tagged-match-no-implicit-bind-mixin> 416 (define-eh-alternative-mixin tagged-match-no-implicit-bind-mixin 417 (pattern (~optional (~global-or no-implicit #:no-implicit-bind))))] 418 419 When used as a match expander, @tc[tagged] expects: 420 421 @itemlist[ 422 @item{The tagged structure's tag name, as defined for the call expander in 423 @racket[<name-id-mixin>]} 424 @item{The @racket[#:no-implicit-bind], which specified that the field name 425 should not automatically be bound by the match pattern to the field's 426 contents: 427 428 @(no-implicit-mixin)} 429 @item{A (possibly empty) list of fields, each associated with zero or more 430 patterns: 431 432 @(match-fields-mixin) 433 434 The main differences with the allowed field specifications for the call 435 expander are that values and types are not allowed, but instead the field name 436 may be followed by match patterns: 437 438 @(parse-field-pats…)}] 439 440 The three elements can appear in any order, with the same constraint as for the 441 call expander: the name must appear before the first field descriptor. 442 443 @(name-after-field-error) 444 445 @chunk[<tagged-match-args-mixin> 446 (define-eh-alternative-mixin tagged-match-args-mixin 447 #:define-syntax-class tagged-match-args-syntax-class 448 (pattern {~mixin name-id-mixin}) 449 (pattern {~mixin tagged-match-no-implicit-bind-mixin}) 450 (pattern {~mixin tagged-match-fields-mixin}))] 451 452 The match expander uses the low-level function @tc[tagged-match!] implemented in 453 @secref["Type_of_a_tagged_structure" 454 #:tag-prefixes '("phc-adt/tagged-low-level")]. It returns 455 the syntax for a match pattern for the given tagged structure. The resulting 456 match pattern checks that the value is an instance of a tagged structure with 457 the given name and fields, and matches the value of each field against the 458 corresponding pattern. 459 460 @chunk[<match-expander> 461 (define/syntax-parse+simple 462 (tagged-match-expander . :tagged-match-args-syntax-class) 463 <match-expander-body>)] 464 465 Unless @racket[#:no-implicit-bind] is specified, we include the field name as 466 part of the pattern, so that field names are bound to the field's contents. 467 468 @chunk[<match-expander-body> 469 (if (attribute no-implicit) 470 (tagged-match! #'(name [fieldᵢ (and patᵢⱼ …)] …)) 471 (tagged-match! #'(name [fieldᵢ (and fieldᵢ patᵢⱼ …)] …)))] 472 473 @section{Predicates for tagged structures} 474 475 @chunk[<tagged?> 476 (define-syntax tagged? 477 (syntax-parser 478 [(_ name fieldᵢ:id …) 479 (tagged-any-predicate! #'(name fieldᵢ …))] 480 [(_ name [fieldᵢ:id :colon τᵢ:type] …) 481 (tagged-predicate! #'(name [fieldᵢ τᵢ] …))] 482 [(_ name [fieldᵢ:id predᵢ:type] …) 483 (tagged-pred-predicate! #'(name [fieldᵢ predᵢ] …))]))] 484 485 @subsection{The @racket[TaggedTop?] predicate} 486 487 The @tc[TaggedTop?] predicate is simply re-provided. It is initially defined in 488 @secref["Common_ancestor_to_all_tagged_structures__TaggedTop-struct" 489 #:tag-prefixes '("phc-adt/tagged-low-level")]. 490 491 @chunk[|<provide TaggedTop?>| 492 (provide (rename-out [TaggedTop-struct? TaggedTop?]))] 493 494 @section{Defining shorthands with @racket[define-tagged]} 495 496 The @tc[define-tagged] macro can be used to bind to an 497 identifier the type expander, match expander, predicate and 498 constructor function for a given tagged structure. 499 500 @chunk[#:save-as tag-kw-mixin <tag-kw-mixin> 501 (define-eh-alternative-mixin tag-kw-mixin 502 (pattern {~optional {~seq #:tag explicit-tag <default-tag-name>}}))] 503 504 @chunk[#:save-as tag-kw-mixin-default <default-tag-name> 505 {~post-check 506 {~bind [tag-name (or (attribute explicit-tag) 507 #'name)]}}] 508 509 @chunk[#:save-as predicate?-mixin <predicate?-mixin> 510 (define-eh-alternative-mixin predicate?-mixin 511 (pattern {~optional {~seq #:? predicate? <default-name?>}}))] 512 513 @chunk[#:save-as predicate?-mixin-default <default-name?> 514 {~post-check 515 {~bind [name? (or (attribute predicate?) 516 (format-id/record #'name "~a?" #'name))]}}] 517 518 The @tc[define-tagged] macro expects: 519 520 @itemlist[ 521 @item{The tagged structure's tag name, as defined for the call expander in 522 @racket[<name-id-mixin>]} 523 @item{An optional list of type variables, as defined for the call expander in 524 @racket[<∀-mixin>]} 525 @item{A possibly empty list of fields, possibly annotated with a type, as 526 defined for the type expander in @racket[<tagged-type-fields-mixin>]} 527 @item{Optionally, the tag name to be used, specified with 528 @racket[#:tag tag-name]: 529 530 @(tag-kw-mixin) 531 532 The tag name defaults to @racket[_name], i.e. the identifier currently being 533 defined. 534 535 @(tag-kw-mixin-default)} 536 @item{Optionally, a name for the predicate, specified with 537 @racket[#:? predicate-name?]: 538 539 @(predicate?-mixin) 540 541 The predicate name defaults to @racket[_name?], where @racket[_name] is the 542 identifier currently being defined. 543 544 @(predicate?-mixin-default)}] 545 546 The five elements can appear in any order, with the same constraint as for the 547 call expander: the name must appear before the first field descriptor. 548 549 @chunk[<define-tagged-args-mixin> 550 (define-eh-alternative-mixin define-tagged-args-mixin 551 #:define-splicing-syntax-class define-tagged-args-syntax-class 552 (pattern (~or {~mixin name-id-mixin} 553 {~mixin tag-kw-mixin} 554 {~mixin tagged-type-fields-mixin} 555 {~mixin predicate?-mixin} 556 {~mixin ∀-mixin})))] 557 558 The @tc[define-tagged] macro is then implemented using @racket[define-multi-id]: 559 560 @CHUNK[<define-tagged> 561 (define-syntax/parse+simple 562 (define-tagged :define-tagged-args-syntax-class) 563 (define-temp-ids "~a/pat" (fieldᵢ …)) 564 (quasisyntax/top-loc stx 565 (begin 566 (define-multi-id name 567 #:type-expander (make-id+call-transformer 568 #'<type-expander/define>) 569 #:match-expander <match-expander/define> 570 #:else <else-expander/define>) 571 (define name? <predicate/define>))))] 572 573 The type expander handles the same three cases as for @tc[tagged]: with type 574 variables, with a type for each field, or inferred. 575 576 @CHUNK[<type-expander/define> 577 #,(if (attribute tvars?) 578 (tagged-∀-type! #'((tvarᵢ …) tag-name [fieldᵢ τᵢ] …)) 579 (if (attribute types?) 580 (tagged-type! #'(tag-name [fieldᵢ τᵢ] …)) 581 (tagged-infer-type! #'(tag-name fieldᵢ …))))] 582 583 The match expander is a short form of the one implemented for @tc[tagged], as it 584 takes only one positional pattern per field. 585 586 @chunk[<match-expander/define> 587 (λ (stx2) 588 (syntax-case stx2 () 589 [(_ fieldᵢ/pat …) 590 (tagged-match! #'(tag-name [fieldᵢ fieldᵢ/pat] …))] 591 (code:comment "Todo: implement a \"rest\" pattern")))] 592 593 Otherwise, when @racket[_name] is called as a function, or used as an identifier 594 on its own, we produce a builder function. When @racket[_name] is called as a 595 function, the builder function is applied immediately to the arguments, 596 otherwise the builder function itself is used. The same three cases as for 597 @tc[tagged] are handled: with type variables, with a type for each field, or 598 inferred. 599 600 @CHUNK[<else-expander/define> 601 #'#,(if (attribute tvars?) 602 (tagged-∀-builder! 603 #'((tvarᵢ …) tag-name [fieldᵢ τᵢ] …)) 604 (if (attribute types?) 605 (tagged-builder! #'(tag-name [fieldᵢ τᵢ] …)) 606 (tagged-infer-builder! #'(tag-name fieldᵢ …))))] 607 608 Finally, we define the predicate @racket[name?]. Contrarily to @racket[tagged?], 609 it does not take into account the field types, as we have no guarantee that 610 Typed/Racket's @racket[make-predicate] works for those. Instead, @racket[name?] 611 recognises any instance of a tagged structure with the given tag name and 612 fields. If a more accurate predicate is desired, it can easily be implemented 613 using @racket[tagged?]. 614 615 @CHUNK[<predicate/define> 616 #,(tagged-any-predicate! #'(tag-name fieldᵢ …))] 617 618 @section{Implementation of @racket[uniform-get]} 619 620 @racket[uniform-get] operates on tagged structures. It retrieves the desired 621 field from the structure, and forces it to obtain the actual value. 622 623 It is implemented as @racket[tagged-get-field] in 624 @secref["Accessing_fields_of_tagged_structures" 625 #:tag-prefixes '("phc-adt/tagged-low-level")], and is 626 simply re-provided here. 627 628 @section{Putting it all together} 629 630 @chunk[<*> 631 (require (for-syntax racket/base 632 racket/syntax 633 syntax/parse 634 phc-toolkit/untyped 635 syntax/strip-context 636 racket/function 637 extensible-parser-specifications 638 racket/format 639 type-expander/expander) 640 phc-toolkit 641 multi-id 642 type-expander 643 racket/promise 644 "tagged-structure-low-level.hl.rkt" 645 racket/format) 646 647 @; Do not use rename-out, as it confuses scribble (two documentations for 648 @; one identifier: the user-level documentation of uniform-get, and the 649 @; low-level documentation of tagged-get-field. 650 (define-syntax uniform-get 651 (make-rename-transformer #'tagged-get-field)) 652 (define-syntax λuniform-get 653 (make-rename-transformer #'λ-tagged-get-field)) 654 (provide uniform-get 655 λuniform-get 656 tagged 657 tagged? 658 define-tagged 659 TaggedTop 660 TaggedTop? 661 662 (for-syntax tagged-call-args-syntax-class 663 tagged-call-expander-forward-attributes 664 tagged-call-expander 665 666 tagged-type-args-syntax-class 667 tagged-type-expander-forward-attributes 668 tagged-type-expander 669 670 tagged-match-args-syntax-class 671 tagged-match-expander-forward-attributes 672 tagged-match-expander 673 674 define-tagged-args-syntax-class 675 define-tagged-forward-attributes)) 676 677 (begin-for-syntax 678 <∀-mixin> 679 <name-id-mixin> 680 <tagged-call-instance-or-builder-mixin> 681 <tagged-call-fields-mixin> 682 <tagged-call-args-mixin> 683 <tagged-type-fields-mixin> 684 <tagged-type-args-mixin> 685 <tagged-match-fields-mixin> 686 <tagged-match-no-implicit-bind-mixin> 687 <tagged-match-args-mixin> 688 689 <predicate?-mixin> 690 <tag-kw-mixin> 691 <define-tagged-args-mixin>) 692 693 (begin-for-syntax 694 <call-expander> 695 <type-expander> 696 <match-expander>) 697 <tagged> 698 <tagged?> 699 <TaggedTop> 700 <define-tagged>] 701 702 @;tagged-call-instance-or-builder-mixin 703 @;tagged-call-fields-mixin 704 @;tagged-call-args-mixin 705 706 @;tagged-type-fields-mixin 707 @;tagged-type-args-mixin 708 709 @;tagged-match-fields-mixin 710 @;tagged-match-no-implicit-bind-mixin 711 @;tagged-match-args-mixin 712 713 @;tag-kw-mixin 714 @;predicate?-mixin 715 @;define-tagged-args-mixin 716 717 @;name-id-mixin 718 @;∀-mixin