# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1484688808 0
# Node ID fbd9837856a842beb9fb7696a2d0ce1c5c093b65
# Parent  3913e79377c14e7549bdc1b6a384135f5c1dd843
Add `defclass*`

diff -r 3913e79377c1 -r fbd9837856a8 DOCUMENTATION.markdown
--- a/DOCUMENTATION.markdown	Mon Jan 16 12:06:45 2017 +0000
+++ b/DOCUMENTATION.markdown	Tue Jan 17 21:33:28 2017 +0000
@@ -275,6 +275,21 @@
 
   
 
+## Package `LOSH.CLOS`
+
+Utilities for working with CLOS.
+
+### `DEFCLASS*` (macro)
+
+    (DEFCLASS* NAME-AND-OPTIONS DIRECT-SUPERCLASSES SLOTS &REST OPTIONS)
+
+`defclass` without the tedium.
+
+  This is like `defclass`, but the `:initarg` and `:accessor` slot options will
+  automatically be filled in with sane values if they aren't given.
+
+  
+
 ## Package `LOSH.CONTROL-FLOW`
 
 Utilities for managing control flow.
diff -r 3913e79377c1 -r fbd9837856a8 losh.lisp
--- a/losh.lisp	Mon Jan 16 12:06:45 2017 +0000
+++ b/losh.lisp	Tue Jan 17 21:33:28 2017 +0000
@@ -1868,6 +1868,36 @@
   (dump-profile filename))
 
 
+;;;; CLOS ---------------------------------------------------------------------
+(defun build-slot-definition (conc-name slot-spec)
+  (destructuring-bind (name &key
+                            (type nil type?)
+                            (documentation nil documentation?)
+                            (initform nil initform?)
+                            (accessor (symb conc-name name))
+                            (initarg (ensure-keyword name)))
+      (ensure-list slot-spec)
+    `(,name
+      :initarg ,initarg
+      :accessor ,accessor
+      ,@(when initform? `(:initform ,initform))
+      ,@(when type? `(:type ,type))
+      ,@(when documentation? `(:documentation ,documentation)))))
+
+(defmacro defclass* (name-and-options direct-superclasses slots &rest options)
+  "`defclass` without the tedium.
+
+  This is like `defclass`, but the `:initarg` and `:accessor` slot options will
+  automatically be filled in with sane values if they aren't given.
+
+  "
+  (destructuring-bind (name &key (conc-name (symb name '-)))
+      (ensure-list name-and-options)
+    `(defclass ,name ,direct-superclasses
+       ,(mapcar (curry #'build-slot-definition conc-name) slots)
+       ,@options)))
+
+
 ;;;; Weightlists --------------------------------------------------------------
 (defstruct (weightlist (:constructor %make-weightlist))
   weights sums items total)
diff -r 3913e79377c1 -r fbd9837856a8 make-docs.lisp
--- a/make-docs.lisp	Mon Jan 16 12:06:45 2017 +0000
+++ b/make-docs.lisp	Tue Jan 17 21:33:28 2017 +0000
@@ -6,6 +6,7 @@
         "LOSH.ARRAYS"
         "LOSH.BITS"
         "LOSH.CHILI-DOGS"
+        "LOSH.CLOS"
         "LOSH.CONTROL-FLOW"
         "LOSH.DEBUGGING"
         "LOSH.ELDRITCH-HORRORS"
diff -r 3913e79377c1 -r fbd9837856a8 package.lisp
--- a/package.lisp	Mon Jan 16 12:06:45 2017 +0000
+++ b/package.lisp	Tue Jan 17 21:33:28 2017 +0000
@@ -46,6 +46,11 @@
     :defun-inline
     :defun-inlineable))
 
+(defpackage :losh.clos
+  (:documentation "Utilities for working with CLOS.")
+  (:export
+    :defclass*))
+
 (defpackage :losh.control-flow
   (:documentation "Utilities for managing control flow.")
   (:export
@@ -260,6 +265,7 @@
    :losh.arrays
    :losh.bits
    :losh.chili-dogs
+   :losh.clos
    :losh.control-flow
    :losh.debugging
    :losh.eldritch-horrors