constructor.hl.rkt (26776B)
1 #lang hyper-literate typed/racket/base #:no-require-lang #:no-auto-require 2 @(require racket/require 3 scribble-math 4 scribble-enhanced/doc 5 (subtract-in scribble/core scribble-enhanced/doc) 6 xlist/scribble-enhanced 7 (for-label (lib "phc-adt/tagged-structure-low-level.hl.rkt") 8 (lib "phc-adt/node-low-level.hl.rkt") 9 (lib "phc-adt/tagged.hl.rkt") 10 xlist 11 racket/list 12 (subtract-in racket/set type-expander) 13 syntax/parse 14 syntax/parse/experimental/template 15 (subtract-in racket/syntax phc-toolkit) 16 phc-toolkit/untyped-only 17 (except-in (subtract-in typed/racket/base type-expander) 18 values) 19 (except-in phc-toolkit ?) 20 multi-id 21 type-expander 22 type-expander/expander)) 23 @doc-lib-setup 24 25 @(unless-preexpanding 26 (require (for-label (submod "..")))) 27 28 @title[#:style (with-html5 manual-doc-style) 29 #:tag "constructor" 30 #:tag-prefix "phc-adt/constructor"]{User API for constructors} 31 32 @(chunks-toc-prefix 33 '("(lib phc-adt/scribblings/phc-adt-implementation.scrbl)" 34 "phc-adt/constructor")) 35 36 @(table-of-contents) 37 38 @section{Introduction} 39 40 This file defines @tc[constructor], a form which allows tagging values, so that 41 two otherwise identical values can be distinguished by the constructors used to 42 wrap them. Coupled with the variants defined by this library, it implements a 43 slight variation on the constructors and variants commonly found in other 44 languages. The @tc[constructor] form is effectively a wrapper around @tc[tagged] 45 structures, which stores all values within a single field named @tc[values]. 46 47 The constructors defined in this library are "interned", meaning that two 48 constructors in different files will be the same if they use same tag name. In 49 other words, the tag of a constructor works in the same way as a symbol in 50 Racket: unless otherwise specified, the same string of characters will always 51 produce the same symbol, even across modules. The same goes for constructors: 52 the same constructor name will always refer to the same type. 53 54 @section{The polyvalent identifier @racket[constructor]: 55 type, match, builder and instance} 56 57 We define the @tc[constructor] macro which acts as a type, a match expander, and 58 a constructor function (which can be called to create a tagged value, i.e. a 59 constructor instance). It can also be directly given a value to directly produce 60 a tagged value, i.e. a constructor instance. 61 62 @chunk[<constructor> 63 (define-multi-id constructor 64 #:type-expander (make-rest-transformer <type-expander>) 65 #:match-expander (make-rest-transformer <match-expander>) 66 #:call (make-rest-transformer <call-expander>))] 67 68 The @tc[constructor?] macro returns a predicate for the 69 given constructor name, or checks if a value is an instance 70 of the given constructor name. This form is implemented in 71 @racket[<predicate>] below. 72 73 @chunk[<constructor?> 74 (define-syntax constructor? (make-rest-transformer <predicate>))] 75 76 @section{Type-expander} 77 78 @chunk[#:save-as constructor-type-types-mixin <constructor-type-types-mixin> 79 (define-eh-alternative-mixin types-mixin 80 (pattern 81 (~maybe/empty (~after name-order-point <name-after-field-error> 82 τᵢ:type … {~lift-rest τ-rest}))))] 83 84 85 @chunk[#:save-as name-after-field-error <name-after-field-error> 86 "The name must appear before any value or type"] 87 88 @chunk[#:save-as name-id-mixin <name-id-mixin> 89 (define-eh-alternative-mixin name-id-mixin 90 (pattern 91 (~once (~order-point name-order-point name:id))))] 92 93 @chunk[#:save-as ∀-mixin <∀-mixin> 94 (define-eh-alternative-mixin ∀-mixin 95 (pattern {~optional (~seq #:∀ ({~named-seq tvarᵢ :id …}) 96 (~global-or tvars?) 97 #;(~global-or [no-types? #f]) 98 #;<∀-fail-no-types>)}))] 99 100 @; TODO: this depends on the order in which mixins are included, because 101 @; no-types? may be declared by a mixin included later on. 102 @chunk[#:save-as ∀-fail-no-types <∀-fail-no-types> 103 #| 104 {~post-fail (string-append "Expected [field:id type:expr] … or" 105 " [field:id : type:expr] … because #:∀ is" 106 " used") 107 #:when (attribute no-types?)} 108 |#] 109 110 The type-expander for @tc[constructor] expects: 111 112 @(require scribble/decode) 113 114 @itemlist[ 115 @item{The constructor's tag name, as defined for the tagged call expander in 116 @(make-link-element 117 #f 118 (racket <name-id-mixin>) 119 `(elem (prefixable "(lib phc-adt/scribblings/phc-adt-implementation.scrbl)" 120 "phc-adt/tagged" 121 "chunk:<name-id-mixin>:1:1"))): 122 123 @(name-id-mixin)} 124 @item{An optional list of type variables, as defined for the tagged call 125 expander in 126 @(make-link-element 127 #f 128 (racket <∀-mixin>) 129 `(elem (prefixable "(lib phc-adt/scribblings/phc-adt-implementation.scrbl)" 130 "phc-adt/tagged" 131 "chunk:<∀-mixin>:1:1"))): 132 133 @(∀-mixin)} 134 @item{An optional list of types: 135 136 @(constructor-type-types-mixin)}] 137 138 The three elements can appear in any order, with one constraint: the name must 139 appear before the first type. Not only does it make more sense semantically, 140 but it also avoids ambiguities when some of the types are plain type 141 identifiers. 142 143 @(name-after-field-error) 144 145 @chunk[<constructor-type-args-mixin> 146 (define-eh-alternative-mixin constructor-type-seq-args-mixin 147 #:define-syntax-class constructor-type-seq-args-syntax-class 148 (pattern {~mixin name-id-mixin}) 149 (pattern {~mixin types-mixin}) 150 (pattern {~mixin ∀-mixin}))] 151 152 The type expander handles two cases: when type variables are present, it uses 153 the low-level function @racket[tagged-∀-type!], otherwise it uses the low-level 154 function @racket[tagged-type!]. The constructor contains a (possibly improper) 155 list of values. The type of that list is expressed using the syntax of the 156 @racketmodname[xlist] library. 157 158 @chunk[<type-expander> 159 (λ/syntax-parse :constructor-type-seq-args-syntax-class 160 (if (attribute tvars?) 161 (tagged-∀-type! #'((tvarᵢ …) name [values (xlist τᵢ … . τ-rest)])) 162 (tagged-type! #'(name [values (xlist τᵢ … . τ-rest)]))))] 163 164 @section{Match-expander} 165 166 @CHUNK[<match-expander> 167 (syntax-parser 168 [(name:id . pats) 169 (tagged-match! #'(name [values (xlist . pats)]))])] 170 171 The match expander simply matches the given patterns against the constructor's 172 single field, @racket[values]. The patterns will usually match one value each, 173 but the @racket[xlist] pattern expander allows a more flexible syntax than the 174 regular @racket[list] match pattern. 175 176 @section{Predicate} 177 178 The @racket[constructor?] macro expands to a predicate and accepts the same 179 syntax as for the type expander, without polymorphic variables. Additionally the 180 resulting type as expanded by @racket[xlist] must be a suitable argument to 181 @racket[make-predicate]. 182 183 @CHUNK[<predicate> 184 (λ/syntax-parse (name:id . types) 185 (tagged-predicate! #'(name [values (xList . types)])))] 186 187 @section{Instance creation} 188 189 The @racket[constructor] macro can return a builder function or an instance. It 190 accepts the following syntaxes: 191 192 @chunk[#:save-as value-maybe-type <value-maybe-type> 193 (define-syntax-class value-maybe-type 194 (pattern [vᵢ :colon τᵢ:type] #:with aᵢ #'τᵢ #:with (tvarₖ …) #'()) 195 (pattern [:colon τᵢ:type vᵢ] #:with aᵢ #'τᵢ #:with (tvarₖ …) #'()) 196 (pattern vᵢ:literal-value 197 #:with τᵢ #'vᵢ.type 198 #:with aᵢ #'vᵢ.type 199 #:with (tvarₖ …) #'()) 200 (pattern (~and vᵢ (~not #:rest)) 201 #:with τᵢ (gensym 'τ) 202 #:attr aᵢ #f 203 #:with (tvarₖ …) #'(τᵢ)))] 204 205 @CHUNK[#:save-as literal-value <literal-value> 206 (define-syntax-class literal-value 207 (pattern n:number #:with type #'n) 208 (pattern s:str #:with type #'s) 209 (pattern b:boolean #:with type #'b) 210 (pattern c:char #:with type #'Char) 211 (pattern ((~literal quote) v) #:with type (replace-chars #'v)) 212 (pattern v 213 #:when (vector? (syntax-e #'v)) 214 #:with type (replace-chars #'v)))] 215 216 @chunk[#:save-as replace-chars <replace-chars> 217 ;https://github.com/racket/typed-racket/issues/434 218 (define (replace-chars t) 219 (cond [(syntax? t) (datum->syntax t 220 (replace-chars (syntax-e t)) 221 t 222 t)] 223 [(pair? t) (list 'Pairof 224 (replace-chars (car t)) 225 (replace-chars (cdr t)))] 226 [(char? t) 'Char] 227 [(vector? t) (cons 'Vector (map replace-chars 228 (vector->list t)))] 229 [(null? t) 'Null] 230 [(number? t) t] 231 [(string? t) t] 232 [(boolean? t) t] 233 (code:comment "Hope for the best.") 234 (code:comment "We really should use a ∀ tvar instead.") 235 [else (list 'quote t)]))] 236 237 @chunk[#:save-as infer-pat <infer-pat> 238 (~after name-order-point <name-after-field-error> 239 {~literal *})] 240 241 @CHUNK[#:save-as call-expander-infer-case <call-expander-cases> 242 [(~no-order {~mixin ∀-mixin} {~mixin name-id-mixin} {~once <infer-pat>}) 243 #`(… (λ #:∀ (A ...) [l : A ... A] 244 (#,(tagged-builder! #'(… (name [values (List A ... A)]))) 245 l)))]] 246 247 @chunk[#:save-as colon-pat <colon-pat> 248 (~after name-order-point <name-after-field-error> 249 :colon τᵢ … 250 {~lift-rest {~and τ-rest ()}})] 251 252 @CHUNK[#:save-as call-expander-:-case <call-expander-cases> 253 [(~no-order {~mixin ∀-mixin} {~mixin name-id-mixin} {~once <colon-pat>}) 254 (define-temp-ids "~a/arg" (τᵢ …)) 255 #`(λ #,@(when-attr tvars? #'(#:∀ (tvarᵢ …))) ([τᵢ/arg : τᵢ] …) 256 (#,(tagged-builder! #'(name [values (List τᵢ …)])) 257 (list τᵢ/arg …)))]] 258 259 @chunk[#:save-as !-pat <!-pat> 260 (~after name-order-point <name-after-field-error> 261 {~datum !} τᵢ … {~lift-rest τ-rest})] 262 263 @CHUNK[#:save-as call-expander-!-case <call-expander-cases> 264 [(~no-order {~mixin ∀-mixin} {~mixin name-id-mixin} {~once <!-pat>}) 265 #`(λ [l : Any *] 266 (#,(tagged-builder! #'(name [values (xList τᵢ … . τ-rest)])) 267 (cast l (xlist τᵢ … . τ-rest))))]] 268 269 @chunk[#:save-as dcolon-pat <dcolon-pat> 270 (~after name-order-point <name-after-field-error> 271 {~datum ::} τᵢ … {~lift-rest τ-rest})] 272 273 @CHUNK[#:save-as call-expander-::-case <call-expander-cases> 274 [(~no-order {~mixin ∀-mixin} {~mixin name-id-mixin} {~once <dcolon-pat>}) 275 (if (attribute tvars?) 276 (tagged-builder! #'(name 277 [values (xlist τᵢ … . τ-rest)])) 278 (tagged-∀-builder! #'((tvarᵢ …) 279 name 280 [values (xList τᵢ … . τ-rest)])))]] 281 282 @CHUNK[#:save-as call-expander-values-case <call-expander-cases> 283 [(~no-order {~mixin ∀-mixin} 284 {~mixin name-id-mixin} 285 (~maybe/empty 286 (~after name-order-point <name-after-field-error> 287 :value-maybe-type … 288 <call-expander-rest>))) 289 (define-temp-ids "~a/arg" (τᵢ …)) 290 (quasitemplate 291 (#,(tagged-∀-builder! #'((tvarᵢ … tvarₖ … … tvar-rest …) 292 name 293 [values (xlist τᵢ … #:rest x-τ-rest)])) 294 (list* {?? (ann vᵢ aᵢ) vᵢ} 295 … 296 {?? (ann v-rest a-rest) v-rest})))]] 297 298 @CHUNK[#:save-as call-expander-rest <call-expander-rest> 299 (~either <call-expander-rest-keyword> 300 <call-expander-empty-rest> 301 <call-expander-dotted-rest>)] 302 303 @(define comment1 "pattern for the value, infers type for literals") 304 @(define-for-syntax comment1 "pattern for the value, infers type for literals") 305 @chunk[#:save-as call-expander-rest-keyword <call-expander-rest-keyword> 306 (~as-rest #:rest 307 (code:comment #,comment1) 308 (~either (~and v-rest:literal-value 309 {~with a-rest #'v-rest.type}) 310 (~and v-rest 311 {~attr a-rest #f})) 312 (~either (~and {~seq} 313 {~with x-τ-rest (gensym 'x-τ-rest)} 314 {~with (tvar-rest …) #'(x-τ-rest)}) 315 (~and (~seq :colon x-τ-rest) 316 {~with (tvar-rest …) #'()})))] 317 318 @CHUNK[#:save-as call-expander-empty-rest <call-expander-empty-rest> 319 (~seq 320 (~lift-rest 321 (~and () 322 {~with v-rest #'null} 323 {~with a-rest #'Null} 324 {~with x-τ-rest #'Null} 325 {~with (tvar-rest …) #'()})))] 326 327 @CHUNK[#:save-as call-expander-dotted-rest <call-expander-dotted-rest> 328 (~seq 329 (~lift-rest 330 (~either (~and v-rest:type-label 331 (~with x-τ-rest #'v-rest.type) 332 {~with a-rest #'v-rest.type} 333 (~with (tvar-rest …) #'())) 334 (~and v-rest:literal-value 335 (~with x-τ-rest #'v-rest.type) 336 {~with a-rest #'v-rest.type} 337 (~with (tvar-rest …) #'())) 338 (~and v-rest 339 (~with x-τ-rest (gensym 'x-τ-rest)) 340 {~attr a-rest #f} 341 (~with (tvar-rest …) #'(x-τ-rest))))))] 342 343 @CHUNK[#:save-as type-label-syntax-class <type-label-syntax-class> 344 (define-syntax-class type-label 345 #:attributes (type raw-type) 346 (pattern v 347 #:attr raw-type (syntax-property #'v-rest 'type-label) 348 #:when (attribute raw-type) 349 #:attr type (datum->syntax #'v-rest 350 (attribute raw-type) 351 #'v-rest)))] 352 353 @itemlist[ 354 @item{@racket[(constructor name *)], which returns a polymorphic builder 355 function that infers the type of its arguments. All arguments are aggregated 356 into a list with the inferred type for each element, and that list is used as 357 the constructor's value. 358 359 @(infer-pat) 360 361 @(call-expander-infer-case)} 362 @item{@racket[(constructor : τᵢ …)], which returns a builder function. This 363 does not support the extended @racket[xlist] syntax, as Typed/Racket's 364 function types are not expressive enough to support it. 365 366 @(colon-pat) 367 368 @(call-expander-:-case)} 369 @item{@racket[(constructor ! . _xlist-type)], which returns a builder function 370 expecting the values as a rest argument, and casts the list at runtime. The 371 @racket[_xlist-type] must be a valid sequence of types for the type form of 372 @racket[xlist], and the result must be a suitable argument to 373 @racket[make-predicate]. 374 375 @(!-pat) 376 377 @(call-expander-!-case)} 378 @item{@racket[(constructor :: . _xlist-type)], which returns a builder function 379 expecting the whole list of values as a single argument, and returns the 380 constructor instance containing that list. The @racket[_xlist-type] must be a 381 valid sequence of types for the type form of @racket[xlist]. 382 383 @(dcolon-pat) 384 385 @(call-expander-::-case)} 386 @item{@racket[(constructor _value-maybe-typeᵢ … . rest)], which returns an 387 instance containing a (possibly improper) list with the given values and 388 @racket[rest] as the tail of the list. If @racket[rest] is @racket[()], then 389 the result is a proper list. 390 391 @;@(constructor-value-mixin) 392 @(call-expander-values-case) 393 394 Each @racket[_value-maybe-typeᵢ] may be one of: 395 @itemlist[ 396 @item{@racket[[valᵢ : τᵢ]]} 397 @item{@racket[[: τᵢ valᵢ]]} 398 @item{@racket[valᵢ]}] 399 400 @(value-maybe-type) 401 402 Literals are specially recognised so that their type is preserved with as much 403 precision as possible: 404 405 @(literal-value) 406 407 As noted in Typed/Racket bug 408 @hyperlink["https://github.com/racket/typed-racket/issues/434"]{#434}, literal 409 characters are not currently recognised as belonging to their own singleton 410 type. We therefore rewrite the type for quoted data to turn literal characters 411 into the @racket[Char] type: 412 413 @(replace-chars) 414 415 Optionally, a rest element may be specified using the following syntax: 416 @(call-expander-rest) 417 418 @(call-expander-rest-keyword) 419 @(call-expander-empty-rest) 420 @(call-expander-dotted-rest) 421 422 The last case depends on the @racket[type-label?] syntax class to recognise 423 uses of the @elem[#:style 'tt "#{val : type}"] type annotation syntax from 424 @racketmodname[typed/racket]. Typed/Racket enables that reader extension, 425 which embeds the type into the value as a syntax property for later use by the 426 type checker 427 428 @(type-label-syntax-class)}] 429 430 All four forms accept a @racket[#:∀ (tvarᵢ …)] specification, and the fourth 431 injects a @racket[tvarᵢ] type variable for values for which no type is given. 432 433 @CHUNK[<call-expander> 434 (syntax-parser 435 <call-expander-cases>)] 436 437 @section{Defining shorthands for constructors with @racket[define-constructor]} 438 439 The @racket[define-constructor] macro binds an identifier to a type-expander, 440 match-expander and call-expander for the constructor with the same name. It 441 also defines a predicate for that constructor type. 442 443 @;; Copied over from tagged.hl.rkt without any change. 444 445 @chunk[#:save-as tag-kw-mixin <tag-kw-mixin> 446 (define-eh-alternative-mixin tag-kw-mixin 447 (pattern {~optional {~seq #:tag explicit-tag <default-tag-name>}}))] 448 449 @chunk[#:save-as tag-kw-mixin-default <default-tag-name> 450 {~post-check 451 {~bind [tag-name (or (attribute explicit-tag) 452 #'name)]}}] 453 454 @chunk[#:save-as predicate?-mixin <predicate?-mixin> 455 (define-eh-alternative-mixin predicate?-mixin 456 (pattern {~optional {~seq #:? predicate? <default-name?>}}))] 457 458 @chunk[#:save-as predicate?-mixin-default <default-name?> 459 {~post-check 460 {~bind [name? (or (attribute predicate?) 461 (format-id/record #'name "~a?" #'name))]}}] 462 463 Like @tc[define-tagged], the @tc[constructor] macro expects: 464 465 @itemlist[ 466 @item{The tagged structure's tag name, as defined for the call expander in 467 @racket[<name-id-mixin>]} 468 @item{An optional list of type variables, as defined for the call expander in 469 @racket[<∀-mixin>]} 470 @item{Optionally, the tag name to be used, specified with 471 @racket[#:tag tag-name] as for @racket[define-tagged] in 472 @secref["Defining_shorthands_with_define-tagged" 473 #:tag-prefixes '("phc-adt/tagged")]: 474 475 @(tag-kw-mixin) 476 477 The tag name defaults to @racket[_name], i.e. the identifier currently being 478 defined. 479 480 @(tag-kw-mixin-default)} 481 @item{Optionally, a name for the predicate, specified with 482 @racket[#:? predicate-name?] as for @racket[define-tagged] in 483 @secref["Defining_shorthands_with_define-tagged" 484 #:tag-prefixes '("phc-adt/tagged")]: 485 486 @(predicate?-mixin) 487 488 The predicate name defaults to @racket[_name?], where @racket[_name] is the 489 identifier currently being defined. 490 491 @(predicate?-mixin-default)}] 492 493 Unlike @tc[define-tagged], which also expects a list of field names possibly 494 annotated with a type, the @tc[constructor] macro instead expects a 495 description of the list of values it contains. Three syntaxes are accepted: 496 497 @itemlist[ 498 @item{@(colon-pat)} 499 @item{@(!-pat)} 500 @item{@(dcolon-pat)}] 501 502 These syntaxes control how the call expander for the defined @racket[_name] 503 works, and have the same meaning as in the call expander for 504 @racket[constructor] (@racket[xlist], @racket[cast] and single-argument 505 @racket[xlist]). 506 507 @chunk[<define-constructor> 508 (define-syntax define-constructor 509 (syntax-parser-with-arrows 510 [(_ . (~no-order {~mixin name-id-mixin} 511 {~mixin ∀-mixin} 512 {~mixin tag-kw-mixin} 513 {~mixin predicate?-mixin} 514 (~once 515 (~and (~seq type-decls …) 516 (~either <colon-pat> 517 <!-pat> 518 <dcolon-pat>))))) 519 #:with tvarᵢ→Any (stx-map (const #'Any) #'(tvarᵢ …)) 520 <normalize-type/define> 521 (quasisyntax/top-loc stx 522 (begin 523 <multi-id/define> 524 <predicate/define>))]))] 525 526 @chunk[<multi-id/define> 527 (define-multi-id name 528 #:type-expander (make-id+call-transformer <type-expander/define>) 529 #:match-expander (make-rest-transformer <match-expander/define>) 530 #:else <call-expander/define>)] 531 532 @; exact copy-paste from the type expander: TODO: factor it out. 533 @CHUNK[<type-expander/define> 534 #'(constructor tag-name 535 #,@(when-attr tvars? #'(#:∀ (tvarᵢ …))) 536 τᵢ … . τ-rest)] 537 538 @CHUNK[<call-expander/define> 539 #'(constructor tag-name 540 #,@(when-attr tvars? #'(#:∀ (tvarᵢ …))) 541 type-decls …)] 542 543 In order to attach patterns to the @racket[xlist] type, pre-process the types 544 using @racket[normalize-xlist-type]. 545 546 @chunk[<normalize-type/define> 547 #:with <with-normalize> (normalize-xlist-type #'(τᵢ … . τ-rest) stx)] 548 549 Once normalized, the types for the @racket[xlist] are all of the form 550 @racket[τᵢ ^ {repeat …}], except for the rest type, which is always present 551 including when it is @racket[Null], and is specified using 552 @racket[#:rest rest-type]. 553 554 @chunk[<with-normalize> 555 ({~seq normalized-τᵢ {~literal ^} (normalized-repeat …)} … 556 #:rest normalized-rest)] 557 558 We then define an argument for the pattern expander corresponding to each type 559 within the normalized sequence: 560 561 @chunk[<normalize-type/define> 562 (define-temp-ids "~a/pat" (normalized-τᵢ …))] 563 564 The match expander expects these patterns and a rest pattern: 565 566 @CHUNK[<match-expander/define> 567 (syntax-parser 568 [({~var normalized-τᵢ/pat} … . {~either <match-rest-signature/define>}) 569 #'#,(tagged-match! #'(name [values <match-xlist/define>]))])] 570 571 The rest pattern can be specified either using a dotted notation if it is a 572 single term, using @racket[#:rest pat-rest], or can be omitted in which case 573 it defaults to matching @racket[null]. The following syntaxes are therefore 574 accepted: 575 576 @chunk[<match-rest-signature/define> 577 (#:rest pat-rest) 578 (~and () {~bind [pat-rest #'(? null?)]}) 579 pat-rest:not-stx-pair] 580 581 The match expander produces an @racket[xlist] pattern using the given patterns 582 and the optional rest pattern. The given patterns are repeated as within the 583 type specification. 584 585 @chunk[<match-xlist/define> 586 (and (? (make-predicate (xlist τᵢ … . τ-rest))) 587 (split-xlist (list normalized-τᵢ/pat … pat-rest) 588 τᵢ … . τ-rest))] 589 590 @CHUNK[<predicate/define> 591 (define name? 592 #,(if (attribute tvars?) 593 (tagged-predicate! 594 #'(tag-name [values ((xlist τᵢ … . τ-rest) tvarᵢ→Any)])) 595 (tagged-predicate! 596 #'(tag-name [values (xlist τᵢ … . τ-rest)]))))] 597 598 @; TODO: add a #:predicate-type option. 599 600 @section{Miscellanea} 601 602 @chunk[<constructor-values> 603 (define-syntax constructor-values 604 (make-id+call-transformer-delayed 605 (λ () #'(λ-tagged-get-field values))))] 606 607 @CHUNK[<ConstructorTop?> 608 (define-syntax ConstructorTop? 609 (make-id+call-transformer-delayed 610 (λ () 611 #`(struct-predicate 612 #,(check-remembered-common! 613 #'(always-remembered values))))))] 614 615 @CHUNK[<ConstructorTop> 616 (define-type-expander (ConstructorTop stx) 617 (syntax-case stx () 618 [id 619 (identifier? #'id) 620 #'((check-remembered-common! 621 #'(always-remembered values)) 622 Any)]))] 623 624 @section{Putting it all together} 625 626 @chunk[<*> 627 (require phc-toolkit 628 "tagged.hl.rkt" 629 "tagged-structure-low-level.hl.rkt" 630 (only-in match-string [append match-append]) 631 type-expander 632 xlist 633 multi-id 634 (for-syntax racket/base 635 syntax/parse 636 syntax/parse/experimental/template 637 racket/contract 638 racket/syntax 639 racket/string 640 racket/function 641 racket/list 642 type-expander/expander 643 phc-toolkit/untyped 644 extensible-parser-specifications)) 645 646 (provide constructor-values 647 constructor 648 constructor? 649 ConstructorTop 650 ConstructorTop? 651 define-constructor 652 (for-syntax constructor-type-seq-args-syntax-class)) 653 654 (begin-for-syntax 655 (define-syntax-class not-stx-pair 656 (pattern {~not (_ . _)})) 657 <type-label-syntax-class> 658 <name-id-mixin> 659 <∀-mixin> 660 <constructor-type-types-mixin> 661 <constructor-type-args-mixin> 662 <tag-kw-mixin> 663 <predicate?-mixin> 664 <replace-chars> 665 <literal-value> 666 <value-maybe-type>) 667 668 <constructor> 669 <constructor?> 670 <ConstructorTop> 671 <ConstructorTop?> 672 <define-constructor> 673 <constructor-values>]