Implementation of the multi-id library
This document describes the implementation of the multi-id library, using literate programming. For the library’s documentation, see the Polyvalent identifiers with multi-id document instead.
1 Syntax properties implemented by the defined multi-id
prop:type-expander, so that the identifier acts as a type expander
«props»1 ::=(?? (?@ #:property prop:type-expander p-type))
Optionally, the user can request the type to not be expanded, in which case we bind the type expression to a temporary type name, using the original define-type from typed/racket:
(?? (tr:define-type name p-type-noexpand #:omit-define-syntaxes))
The user can otherwise request that the type expression be expanded once and for all. This can be used for performance reasons, to cache the expanded type, instead of re-computing it each time the name identifier is used as a type. To achieve that, we bind the expanded type to a temporary type name using define-type as provided by the type-expander library:
(?? (define-type name p-type-expand-once #:omit-define-syntaxes))
The two keywords #:type-noexpand and #:type-expand-once can also be used to circumvent issues with recursive types (the type expander would otherwise go in an infinite loop while attempting to expand them). This behaviour may be fixed in the future, but these options should stay so that they can still be used for performance reasons.
prop:match-expander, so that the identifier acts as a match expander
«props»2 ::=(?? (?@ #:property prop:match-expander p-match)) (?? (?@ #:property prop:match-expander (λ (stx) (syntax-case stx () [(_ . rest) #'(p-match-id . rest)])))) prop:custom-write, so that the identifier can be printed in a special way. Note that this does not affect instances of the data structure defined using multi-id. It is even possible that this property has no effect, as no instances of the structure should ever be created, in practice. This feature is therefore likely to change in the future.
«props»3 ::=(?? (?@ #:property prop:custom-write p-write))
prop:set!-transformer, so that the identifier can act as a regular macro, as an identifier macro and as a set! transformer.
«props»4 ::=#:property prop:set!-transformer (?? p-set! (λ (_ stx) (syntax-case stx (set!) [(set! self . rest) (?? p-set! «fail-set!»)] (?? [(_ . rest) p-just-call]) (?? [_ p-just-id])))) Any prop:xxx identifier can be defined with #:xxx, if so long as the prop:xxx identifier is a struct-type-property?.
«props»5 ::=
The multi-id macro therefore defines name as follows:
(template (begin «maybe-define-type» (define-syntax name (let () (struct tmp () «props») (tmp)))))
2 Signature of the multi-id macro
The multi-id macros supports many options, although not all combinations are legal. The groups of options specify how the name identifier behaves as a type expander, match expander, how it is printed with prop:custom-write and how it acts as a prop:set!-transformer, which covers usage as a macro, identifier macro and actual set! transformer.
These groups of options are detailed below:
The #:type-expander, #:type-noexpand and #:type-expand-once options are mutually exclusive.
The #:match-expander and #:match-expander-id options are mutually exclusive.
The #:custom-write keyword can always be used
The prop:set!-transformer can be specified as a whole using #:set!-transformer, or using one of #:else, #:else-id, #:mutable-else or #:mutable-else-id, or using some combination of #:set!, #:call (or #:call-id) and #:id.
More precisely, the kw-else syntax class accepts one of the mutually exclusive options #:else, #:else-id, #:mutable-else and #:mutable-else-id:
(define-splicing-syntax-class kw-else #:attributes (p-just-set! p-just-call p-just-id) (pattern (~seq #:mutable-else p-else) #:with p-just-set! #'#'(set! p-else . rest) #:with p-just-call #'#'(p-else . rest) #:with p-just-id #'#'p-else) (pattern (~seq #:else p-else) #:with p-just-set! «fail-set!» #:with p-just-call #'#`(#,p-else . rest) #:with p-just-id #'p-else) (pattern (~seq #:mutable-else-id p-else-id) #:with (:kw-else) #'(#:mutable-else #'p-else-id)) (pattern (~seq #:else-id p-else-id) #:with (:kw-else) #'(#:else #'p-else-id))) The kw-set!+call+id syntax class accepts optionally the #:set! keyword, optionally one of #:call or #:call-id, and optionally the #:id keyword.
(define-splicing-syntax-class kw-set!+call+id (pattern (~seq (~or (~optional (~seq #:set! p-user-set!:expr)) (~optional (~or (~seq #:call p-user-call:expr) (~seq #:call-id p-user-call-id:id))) (~optional (~or (~seq #:id p-user-id:expr) (~seq #:id-id p-user-id-id:expr)))) …) #:attr p-just-set! (and (attribute p-user-set!) #'(p-user-set! stx)) #:attr p-just-call (cond [(attribute p-user-call) #'(p-user-call stx)] [(attribute p-user-call-id) #'(syntax-case stx () [(_ . rest) #'(p-user-call-id . rest)])] [else #f]) #:attr p-just-id (cond [(attribute p-user-id) #'(p-user-id stx)] [(attribute p-user-id-id) #'#'p-user-id-id] [else #f]))) When neither the #:set! option nor #:set!-transformer are given, the name identifier acts as an immutable object, and cannot be used in a set! form. If it appears as the second element of a set! form, it raises a syntax error:
«fail-set!» ::=#'(raise-syntax-error 'self (format "can't set ~a" (syntax->datum #'self))) As a fallback, for any #:xxx keyword, we check whether a corresponding prop:xxx exists, and whether it is a struct-type-property?:
«fallback-kw» ::=(~seq fallback:prop-keyword fallback-value:expr)
The check is implemented as a syntax class:
(define-syntax-class prop-keyword (pattern keyword:keyword #:with prop (datum->syntax #'keyword (string->symbol (string-append "prop:" (keyword->string (syntax-e #'keyword)))) #'keyword #'keyword) #:when (eval #'(struct-type-property? prop))))
3 Tests for multi-id
(define (p1 [x : Number]) (+ x 1)) (define-type-expander (Repeat stx) (syntax-case stx () [(_ t n) #`(List #,@(map (λ (x) #'t) (range (syntax->datum #'n))))])) (define-multi-id foo #:type-expander (λ (stx) #'(List (Repeat Number 3) 'x)) #:match-expander (λ (stx) #'(vector _ _ _)) #:custom-write (λ (self port mode) (display "custom-write for foo" port)) #:set!-transformer (λ (_ stx) (syntax-case stx (set!) [(set! self . _) (raise-syntax-error 'foo (format "can't set ~a" (syntax->datum #'self)))] [(_ . rest) #'(+ . rest)] [_ #'p1]))) (check-equal? (ann (ann '((1 2 3) x) foo) (List (List Number Number Number) 'x)) '((1 2 3) x)) ;(set! foo 'bad) should throw an error here (let ([test-match (λ (val) (match val [(foo) #t] [_ #f]))]) (check-equal? (test-match #(1 2 3)) #t) (check-equal? (test-match '(1 x)) #f)) (check-equal? (foo 2 3) 5) (check-equal? (map foo '(1 5 3 4 2)) '(2 6 4 5 3))
It would be nice to test the (set! foo 'bad) case, but grabbing the compile-time error is a challenge (one could use eval, but it’s a bit heavy to configure).
Test with #:else:
(begin-for-syntax (define-values (prop:awesome-property awesome-property? get-awesome-property) (make-struct-type-property 'awesome-property))) (define-multi-id bar-id #:type-expander (λ (stx) #'(List `,(Repeat 'x 2) Number)) #:match-expander (λ (stx) #'(cons _ _)) #:custom-write (λ (self port mode) (display "custom-write for foo" port)) #:else-id p1 #:awesome-property 42) (check-equal? (ann (ann '((x x) 79) bar) (List (List 'x 'x) Number)) '((x x) 79)) ;(set! bar 'bad) should throw an error here (let ([test-match (λ (val) (match val [(bar-id) #t] [_ #f]))]) (check-equal? (test-match '(a . b)) #t) (check-equal? (test-match #(1 2 3)) #f)) (let ([f-bar-id bar-id]) (check-equal? (f-bar-id 6) 7)) (check-equal? (bar-id 6) 7) (check-equal? (map bar-id '(1 5 3 4 2)) '(2 6 4 5 3)) (require (for-syntax rackunit)) (define-syntax (check-awesome-property stx) (syntax-case stx () [(_ id val) (begin (check-pred awesome-property? (syntax-local-value #'id (λ _ #f))) (check-equal? (get-awesome-property (syntax-local-value #'id (λ _ #f))) (syntax-e #'val)) #'(void))])) (check-awesome-property bar-id 42)
(define-multi-id bar #:type-expander (λ (stx) #'(List `,(Repeat 'x 2) Number)) #:match-expander (λ (stx) #'(cons _ _)) #:custom-write (λ (self port mode) (display "custom-write for foo" port)) #:else #'p1) (check-equal? (ann (ann '((x x) 79) bar) (List (List 'x 'x) Number)) '((x x) 79)) ;(set! bar 'bad) should throw an error here (let ([test-match (λ (val) (match val [(bar) #t] [_ #f]))]) (check-equal? (test-match '(a . b)) #t) (check-equal? (test-match #(1 2 3)) #f)) (check-equal? (bar 6) 7) (check-equal? (map bar '(1 5 3 4 2)) '(2 6 4 5 3))
4 Conclusion
(require (only-in type-expander prop:type-expander define-type) (only-in typed/racket [define-type tr:define-type]) phc-toolkit/untyped (for-syntax phc-toolkit/untyped racket/base racket/syntax syntax/parse syntax/parse/experimental/template (only-in type-expander prop:type-expander))) (provide define-multi-id) «multi-id» (module* test-syntax racket/base (provide tests) (define tests #'(begin «test-multi-id»)))