6 Supertypes of tagged structures
6.1 type-expander
(define-multi-id tagged-supertype #:type-expander «tagged-supertype-type-expander» #:match-expander «tagged-supertype-match-expander»)
As a type, tagged-supertype accepts two syntaxes. With the first one, the type of each field is specified, and the second returns a parametric structure:
The type uses the structure type-expander, and expands to the union of all structures which contain a superset of the given set of fields. It uses the specified type for the given fields, and defaults to Any for the other extra fields.
(has-fields/type #'([field type] …))
The second syntax builds upon the first, and produces a parametric type, with a ∀ type argument for each specified field (other fields still falling back to Any).
(define-temp-ids "~a/τ" (field …)) #`(∀ (field/τ …) #,(has-fields/type #'([field field/τ] …)))
The type-expander finally calls either case depending on the syntax used.
6.2 Match
The match-expander for tagged-supertype accepts all structures which contain a superset of the given set of fields:
(λ/syntax-parse (_ . :tagged-match-args-syntax-class) (define/with-syntax ([common . (all-field …)] …) (has-fields/common #'(fieldᵢ …))) (define/with-syntax ((maybe-fieldᵢ …) …) (if (attribute no-implicit) (map (const #'()) #'(fieldᵢ …)) #'((fieldᵢ) …))) (define/with-syntax ((maybe-pats …) …) (quasitemplate ((«maybe-pat…» …) …))) #`(or (tagged name #:no-implicit-bind [all-field . maybe-pats] …) …))
(define-match-expander tagged-anytag-match (λ/syntax-case ([fieldᵢ patᵢⱼ …] …) () (tagged-anytag-match! #'([fieldᵢ (and patᵢⱼ …)] …))))
Each field that was passed to tagged-supertype additionally matches against the given pat …, and other fields do not use any extra pattern.
(!cdr-assoc #:default [] all-field [fieldᵢ . [maybe-fieldᵢ … patᵢⱼ …]] …)
6.3 Nested supertype
The (tagged-supertype* f₁ f₂ … fₙ T) type describes any structure containing a field f₁, whose type is any structure containing a field f₂ etc. The last field’s type is given by T.
(define-multi-id tagged-supertype* #:type-expander (λ (stx) (error (string-append "tagged-supertype* is currently broken (needs" " to ignore the tag name, since it doe not" " have a tag at each step.")) (syntax-parse stx [(_ T:expr) #`T] [(_ T:expr field:id other-fields:id …) #`(tagged-supertype [field (tagged-supertype* T other-fields …)])])) ;#:match-expander <tagged-supertype-match-expander> ; TODO)
6.4 Conclusion
(require (for-syntax racket/base racket/function racket/syntax syntax/parse syntax/parse/experimental/template phc-toolkit/untyped type-expander/expander) phc-toolkit multi-id type-expander "tagged-structure-low-level.hl.rkt" "tagged.hl.rkt") (provide tagged-supertype tagged-supertype*) «tagged-anytag-match» «tagged-supertype» «tagged-supertype*»