(defmacro defclass* (name)
  `(defclass ,name () ()))

(defun create-property-class (node)
  (let ((ancestor (get node 'isa)))
    (if (not (null ancestor))
        (create-property-class ancestor))
    (defclass* node)))

To demonstrate the problem, setup 3 nodes (programmer and
person both have super-class names that are properties and
mammal is a base class with a slot called "breathes" and it
does not have a super-class):

(setf (get 'programmer 'isa) 'person)
(setf (get 'person 'isa) 'mammal)
(setf (get 'mammal 'breathes) 'air)
(setq my-node 'programmer)

In the listener, here is what happens when I try to create the
class definitions:

[16]> (defclass* programmer)
#<STANDARD-CLASS PROGRAMMER>
[17]> (create-property-class 'programmer)
#<STANDARD-CLASS NODE>
[18]> (create-property-class my-node)
#<STANDARD-CLASS NODE>

When I run the defclass* macro directly from the top level,
the class is created correctly; however, when I run the
create-property-class function it does not. I understand why
it doesn't work properly when I run the function but I don't
know how to fix the problem. I've been banging my head against
the wall all night trying different things but haven't been
able to come up with a solution. I would appreciate any
suggestions or pointers that might explain what I should be
doing.

(defun create-property-class (node)
  (let ((ancestor (get node 'isa)))
    (if (not (null ancestor))
        (create-property-class ancestor))
    (eval `(defclass ,node (,ancestor) ()))))

I'm ad-libing a bit, assuming that you want ancestor as a superclass
of node.  Note that you don't have to define ancestor before node as
long as ancestor is defined before any nodes are instantiated.

(I added the mop: package prefixes to the appropriate calls for ACL.
This is also necessary for CMUCL, but you have to do mop:find-class
and mop:class-name as well.)

(Anyone know why this doesn't work with CMUCL?)

(defun make-programmatic-instance (superclass-names &rest initargs)
  (apply #'make-instance
         (find-programmatic-class
           (mapcar #'find-class superclass-names))
         initargs))

(defun find-programmatic-class (superclasses)
  (let ((class (find-if
                 #'(lambda (class)
                     (equal superclasses
                            (mop:class-direct-superclasses class)))
                 (mop:class-direct-subclasses (car superclasses)))))
    (if class
        class
        (make-programmatic-class superclasses))))

(defun make-programmatic-class (superclasses)
  (make-instance 'standard-class
    :name (mapcar #'class-name superclasses)
    :direct-superclasses superclasses
    :direct-slots ()))

#|
;; Tests

(defclass shape () ())
(defclass circle (shape) ())
(defclass triangle (shape) ())
(defclass pentagon (shape) ())
(defclass color () ())
(defclass fuchsia (color) ())
(defclass orange (color) ())
(defclass magenta (color) ())
(defclass label-type () ())
(defclass top-labeled (label-type) ())
(defclass center-labeled (label-type) ())
(defclass bottom-labeled (label-type) ())

;; (defclass orange-top-labeled-circle (circle orange top-labeled) ())

(make-programmatic-instance '(circle orange top-labeled))

(setq i1 (make-programmatic-instance '(circle orange top-labeled))
      i2 (make-programmatic-instance '(circle magenta bottom-labeled))
      i3 (make-programmatic-instance '(circle orange top-labeled)))

(mop:class-direct-subclasses (find-class 'circle))

|#

  I suggest that you macroexpand the `defpackage´ form to see what it does.

--
Erik Naggum, Oslo, Norway

[2]> (macroexpand '(defpackage mypackage (:use common-lisp) (:export "my-func")))
(EVAL-WHEN (LOAD COMPILE EVAL)
 (SYSTEM::%IN-PACKAGE "MYPACKAGE" :NICKNAMES 'NIL :USE 'NIL)
 (USE-PACKAGE '("COMMON-LISP") "MYPACKAGE")
 (SYSTEM::INTERN-EXPORT '("my-func") "MYPACKAGE") (FIND-PACKAGE "MYPACKAGE")) ;
T

I can't see what clues this provides me with. Did you mean for me to
expand 'defclass' instead of 'defpackage'? When I expand 'defclass', I
get this:

[13]> (macroexpand '(defclass xxx (super-classes) ()))
(LET NIL
 (EVAL-WHEN (COMPILE LOAD EVAL)
  (CLOS::ENSURE-CLASS 'XXX :DIRECT-SUPERCLASSES
   (LIST (FIND-CLASS 'SUPER-CLASSES)) :DIRECT-SLOTS (LIST)))
 (FIND-CLASS 'XXX)) ;
T

This does give me some clues as it shows me that the macro 'defclass' uses
the function 'clos::ensure-class' to create the class definition. This is
what Tim Moore alluded to in his earlier email and (if I had used
'ensure-class' rather than 'defclass'), that would have been a valid
approach to get around my problem.

Did you make a typo or is there something I'm missing? If it really was
'defpackage' that you thought would be useful for me to look at,
please give me some idea as to what part of the macroexpansion relates
specifically to my problem.

  Yes.  Sorry for the confusion caused by the typo/thinko.

--
Erik Naggum, Oslo, Norway

This is one of those rare cases where you really do need to use EVAL.
That is because there is no portable way of creating classes with a
function call -- the DEFCLASS macro is all you've got.  You will
need something like:

(defun create-property-class (node)
  (let ((ancestor (get node 'isa)))
    (if (not (null ancestor))
        (create-property-class ancestor))
        (eval `(defclass ,node () ()))))