Defining the runtime value of a struct name

General
21

Thanks to @shhyou's work, my original example is shown working here:

#lang s-exp "struct-with-name-expr.rkt"

(struct singleton (a b)
  #:name-expr (singleton-constructor 'hello 'world)
  #:constructor-name singleton-constructor
  #:transparent)

(provide (struct-out singleton))

(module* main racket/base
  (require (submod "..") racket/match)

  singleton
  ;; (singleton 'hello 'world)

  (match singleton ((struct singleton (a b)) a))
  ;; 'hello
  )

Doing a complete job of this would require a lot of work with syntax-parse or require patching the original struct macro source code. Here my very limited version, which is hard coded to only parse the pattern of the original example when using #:name-expr:

#lang racket/base

(require (for-syntax syntax/parse
                     syntax/transformer
                     racket/list
                     racket/base
                     racket/syntax
                     racket/struct-info)
         racket/match)

(provide (except-out (all-from-out racket/base)
                     struct)
         (rename-out (struct* struct)))

(begin-for-syntax
  (struct id-with-struct-info (macro-proc info)
    #:property prop:procedure (struct-field-index macro-proc)
    #:property prop:struct-info (lambda (self)
                                  (id-with-struct-info-info self))
    #:transparent))

(define-syntax (struct* stx)
  (syntax-parse stx
    ((_ name (field ...)
        #:name-expr name-expr:expr
        #:constructor-name constructor-id:id
        #:transparent)
     (with-syntax ((transformer-id (format-id #'name "~a-t" (syntax-e #'name))))
       #'(begin
           (struct name (field ...)
             #:name transformer-id
             #:constructor-name constructor-id
             #:transparent)
           (define name1 name-expr)
           (define-syntax name
             (id-with-struct-info (make-variable-like-transformer #'name1)
                                  (list-set (extract-struct-info (syntax-local-value #'transformer-id))
                                            1
                                            #'name))))))
    ((_ name (field ...) more ...)
     #'(struct name (field ...) more ...))))

Amazing!

1 Like