Implementation of the multi-id library
1 Syntax properties implemented by the defined multi-id
«props»1
«maybe-define-type»1
«maybe-define-type»2
«props»2
«props»3
«props»4
«props»5
«multi-id-body»
2 Signature of the multi-id macro
«multi-id»
«type-expander-kws»
«match-expander-kws»
«custom-write-kw»
«set!-transformer-kws»
«stx-class-kw-else»
«stx-class-kw-set!+call+id»
«fail-set!»
«fallback-kw»
«prop-keyword-syntax-class»
3 Tests for multi-id
«test-multi-id»1
«test-multi-id»2
«test-multi-id»3
4 Conclusion
«*»
6.12

Implementation of the multi-id library

Georges Dupéron <[email protected]>

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

The multi-id macro defines the identifier name as a struct with several properties:

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.

(begin-for-syntax
  «stx-class-kw-else»
  «stx-class-kw-set!+call+id»
  «prop-keyword-syntax-class»)
(define-syntax/parse (define-multi-id name:id
                       (~or «type-expander-kws»
                            «match-expander-kws»
                            «custom-write-kw»
                            «set!-transformer-kws»
                            «fallback-kw»)
                       )
  «multi-id-body»)

These groups of options are detailed below:

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»)))