;;; Arl Standard Library - Struct Macros

(module struct
  (export defstruct)

  (import functional :refer (map mapcat))
  (import display :refer (string-concat))
  (import core :refer (r-call))

;;' @section Struct Definition

;;' @description Define a struct constructor, predicate, and accessors.
;;' @param name Name for the struct type
;;' @param fields List of field name symbols
;;' @examples
;;' ;; Define a Point struct
;;' (defstruct Point (x y))
;;'
;;' ;; Constructor: make-Point
;;' (define p (make-Point 3 4))
;;'
;;' ;; Predicate: Point?
;;' (Point? p)                  ; => #t
;;' (Point? 42)                 ; => #f
;;'
;;' ;; Accessors: Point-x, Point-y
;;' (Point-x p)                 ; => 3
;;' (Point-y p)                 ; => 4
;;' @assert
;;' (defstruct _TestPt (x y))
;;' (define _test-pt (make-_TestPt 3 4))
;;' (assert-true (_TestPt? _test-pt))
;;' (assert-false (_TestPt? 42))
;;' (assert-equal 3 (_TestPt-x _test-pt))
;;' (assert-equal 4 (_TestPt-y _test-pt))
;;' @note `defstruct` generates a constructor (`make-Name`), a type predicate (`Name?`), and field accessors (`Name-field`) for each field. The struct is backed by an R named list with an S3 class.
;;' @seealso dict
(defmacro defstruct (name fields)
  (define struct-name (as.character name))
  (define ctor-name (as.symbol (string-concat "make-" struct-name)))
  (define pred-name (as.symbol (string-concat struct-name "?")))
  (define field-pairs
    (mapcat
      (lambda (field)
        (list (structure (as.character field) :class "arl_keyword") field))
      fields))
  (define accessors
    (map
      (lambda (field)
        (define accessor-name (as.symbol (string-concat struct-name "-" (as.character field))))
        `(define ,accessor-name
           (lambda (obj)
             (r-call "[["
               (list obj ,(as.character field)))
           )))
      fields))
  `(begin
     (define ,ctor-name
       (lambda (,@fields)
         (structure (list ,@field-pairs) :class ,struct-name)))
    (define ,pred-name
      (lambda (obj)
        (inherits obj ,struct-name)))
     ,@accessors))
)
