DEFINE-RECORD for defining single-constructor product types with accessors.

[chebert]

I wrote a pair of macros for defining "a poor man's" record type.
I have experienced that being able to have function accessors can make code more concise.

define-record creates a type and generates accessors for that type.

;;; DEFINE-RECORD is used for defining a product type with functional accessors to it.
;; Matching is nice but it isn't first-class like functions.
;; Thankfully it's easy to generate functions if the type is a single-constructor product type.
;; Accessors are:
;;   getters of the form record-name.field-name with type (:record -> :field)
;;   modifiers of the form record-name.field-name% with type ((:field -> :field) -> :record -> :record)

;; define-record-accessors only defines the accessor functions.
(cl:defmacro define-record-accessors (name constructor-name cl:&body field-names)
  (cl:let* (;; names used in definitions for accessors
	    (record-var (cl:gensym "RECORD"))
	    (update-var (cl:gensym "UPDATE"))
	    (value-var (cl:gensym "VALUE"))

	    ;; Field getters are RECORD-NAME.FIELD-NAME
	    (field-getters (cl:mapcar (cl:lambda (field-name)
					(cl:intern (cl:format nil "~A.~A" name field-name)))
				      field-names))
	    ;; Field modifiers are RECORD-NAME.FIELD-NAME%
	    (field-modifiers (cl:mapcar (cl:lambda (field-name)
					  (cl:intern (cl:format nil "~A.~A%" name field-name)))
					field-names)))
    `(coalton-toplevel
       ,@(cl:loop for i from 0
	    for field-name in field-names
	    for field-getter in field-getters
	    for field-modifier in field-modifiers
	    appending
	    `((define (,field-getter ,record-var)
		(match ,record-var
		  ;; Perform a match of ((_CONSTRUCTOR _ _ ... value-var _ _) value-var)
		  ((,constructor-name ,@(cl:make-list i :initial-element '_)
				      ,value-var
				      ,@(cl:make-list (cl:- (cl:length field-names) i 1) :initial-element '_))
		   ,value-var)))
	      (define (,field-modifier ,update-var ,record-var)
		(,constructor-name
		 ;; Copy the fields from the given record-var
		 ,@(cl:mapcar (cl:lambda (getter) `(,getter ,record-var)) (cl:subseq field-getters 0 i))
		 ;; update the field from the given record-var
		 (,update-var (,field-getter ,record-var))
		 ;; Copy the remaining fields from the given record-var
		 ,@(cl:mapcar (cl:lambda (getter) `(,getter ,record-var)) (cl:subseq field-getters (cl:1+ i))))))))))

;; define-record defines the type and the accessors.
(cl:defmacro define-record (name-and-type-parameters cl:&body fields)
  (cl:let* ((name (cl:if (cl:listp name-and-type-parameters)
			 (cl:first name-and-type-parameters)
			 name-and-type-parameters))

	    ;; Name of the constructor is _RECORD-NAME
	    (constructor-name (cl:intern (cl:format nil "_~A" name)))
	    (field-names (cl:mapcar #'cl:first fields))
	    (field-types (cl:mapcar #'cl:second fields)))
    `(cl:progn
       (coalton-toplevel
	 (define-type ,name-and-type-parameters
	   (,constructor-name ,@field-types)))
       (define-record-accessors ,name ,constructor-name ,@field-names))))


;; Example usage of define-record
#+nil
(define-record (example :color)
  (name string)
  (age Integer)
  (favorite-color :color))

#+nil
(COMMON-LISP:PROGN
  (COALTON-TOPLEVEL
    (DEFINE-TYPE (EXAMPLE :COLOR)
      (_EXAMPLE STRING INTEGER :COLOR)))
  (COALTON-TOPLEVEL
    (DEFINE (EXAMPLE.NAME #:RECORD684)
      (MATCH #:RECORD684
	((_EXAMPLE #:VALUE686 _ _) #:VALUE686)))
    (DEFINE (EXAMPLE.NAME% #:UPDATE685 #:RECORD684)
      (_EXAMPLE (#:UPDATE685 (EXAMPLE.NAME #:RECORD684))
		(EXAMPLE.AGE #:RECORD684) (EXAMPLE.FAVORITE-COLOR #:RECORD684)))
    (DEFINE (EXAMPLE.AGE #:RECORD684)
      (MATCH #:RECORD684
	((_EXAMPLE _ #:VALUE686 _) #:VALUE686)))
    (DEFINE (EXAMPLE.AGE% #:UPDATE685 #:RECORD684)
      (_EXAMPLE (EXAMPLE.NAME #:RECORD684)
		(#:UPDATE685 (EXAMPLE.AGE #:RECORD684))
		(EXAMPLE.FAVORITE-COLOR #:RECORD684)))
    (DEFINE (EXAMPLE.FAVORITE-COLOR #:RECORD684)
      (MATCH #:RECORD684
	((_EXAMPLE _ _ #:VALUE686) #:VALUE686)))
    (DEFINE (EXAMPLE.FAVORITE-COLOR% #:UPDATE685 #:RECORD684)
      (_EXAMPLE (EXAMPLE.NAME #:RECORD684) (EXAMPLE.AGE #:RECORD684)
		(#:UPDATE685 (EXAMPLE.FAVORITE-COLOR #:RECORD684))))))

#+nil
(coalton
 (let ((example (_example "George" 31 "Blue")))
   (tuple (example.favorite-color example)
	  (example.age% (+ 1) example))))
;; #.(TUPLE "Blue" #.(_EXAMPLE "George" 32 "Blue"))

---

Some Limitations:

A limitation of the accessor functions is that I can update only one field at a time. However, we still have pattern matching, so in that case we can just use a match.

I would prefer that the macros could be used inside of another coalton-toplevel, but I wasn't sure how. Sorry if its obvious and I missed it.

I prefixed type constructor names with an underscore because it helps me avoid name clashes with variables. This may not mesh with coalton's style.

---

Any thoughts on a record syntax like this or something completely different?

P.S. Haven't forgotten about making a PR for the state monad. Next on my list.

[mmontone]

I also made an experiment of records syntax a couple of days ago: https://gist.github.com/mmontone/990f5731f5dd54973f327c9ceecf3386

[chebert]

I like that you can update multiple fields at once with your syntax. I like the keyword arguments too for named fields.

I wondered if there is a good way to produce functional interfaces for the updates. Something like (update-person firstname age) would produce (string -> integer -> person -> person).

The equivalent in the syntax I presented in the OP would be

(fn (name age) (compose (person.firstname% name) (person.age% age))

and for your syntax it would be:

(fn (name age p) (update-person p firstname name age age)) 

I would like to have a functional update like

(update-person firstname age)

These are all first class functions that you can pass around to other functions, with the last being the most concise way I can think of to flexibly produce one.

Good stuff, thanks for sharing. I might take a crack at that last syntax and see how I actually like it.