Struct construction using dictionaries

struct-with-dict-construction.rkt

#lang racket/base

;;; License: [Apache License, Version 2.0](http://www.apache.org/licenses/LICENSE-2.0) or
;;;          [MIT license](http://opensource.org/licenses/MIT) at your option.

(require racket/list)

(define mstructs (make-hasheq))

;; mstruct's can be used just like normal structs, but can also use the nicer `construct` constructor.

(define-syntax mstruct
  (syntax-rules ()
    [(_ name parent (fields ...))
     (begin
       (struct name parent (fields ...) #:transparent)
       ; Note that the key is the struct constructor, not its symbolic name,
       ; as the name may not be unique (globally).
       (hash-set! mstructs name `(name ,parent (fields ...))))]
    
    [(_ name (fields ...))
     (begin
       (struct name  (fields ...) #:transparent)
       (hash-set! mstructs name '(name #f (fields ...)))
       )]))

(define no-key (string->uninterned-symbol "no-key"))

(define-syntax-rule (construct name [key val] ...)
  (let ()
    (define h (make-hasheq `((key . ,val) ...)))
    ; construct the list of argument names
    
    (define fields
      (let loop ([name name] [fields '()])
        (cond
          [name
           (define info (hash-ref mstructs name
                                  (λ () (error 'construct
                                               "~a, ~a has not been constructed with mstruct"
                                               'name name))))
           (loop (second info) (append (third info) fields))]
          [else fields])))
    (define vals
      (for/list ([f (in-list fields)])
        (define v (hash-ref h f no-key)) ; default-value?
        (cond [(eq? v no-key) no-key]
              [else (hash-remove! h f)
                    v])))
    (unless (hash-empty? h)
      (error 'construct "Unused keys: ~a" (hash-keys h)))
    (apply name vals)))

(mstruct A (one two))

#;(construct A [one 1] [plop 'plop]) ; error
(construct A [one 1])

(mstruct B A (three four))

(construct B [one 'a] [three 3] [two 'b] )


(struct C B (five))
#;(construct C [five 5]) ; error