In common lisp, what is a function that returns the most specific supertype of two objects?

Question

I am most interested in the applicability to SBCL, but am curious about other implementations of Common Lisp as well.

In Common Lisp we have the type hierarchy.

I would like a function that, given two objects as parameters, returns the symbol signifying the most specific super-type applicable to those two objects. Its use would look something like:

(most-specific-super-type x y)

So for instance, a short-float and a long-float are both sub-types of the super-type float.

If a long-float and an integer were compared, the most specific super-type is real.

And if a complex number and a float were compared, the most specific super-type is number.

Comparing two objects from separate trees in that type hierarchy, we would presumably be returned the type T or possibly atom in the case where the object is not a cons.

I'd love to avoid having to write this myself, and my gut tells me that it seems like the kind of function that has already been written.

I'm primarily interested in the already defined types in the standard language, but my gut also tells me that there must be a function somewhat related to this for CLOS classes, in order to determine class precedence.

So if there was a function that would be applicable to both the classes and types together, that would be super, but i would be happy if there's a solution for just the types...

Answer 1

As I think this will be of worth to others, and I've been unable to find such a solution myself anywhere after a substantial search, and I haven't been getting too many bites, I've had a go at whipping up the basic unoptimised logic for a solution myself.

This is not a final working version, but should get anyone else looking for the same problem to a solution, upon which point they can harden and refactor. Please comment and offer any corrections/fixes/issues.

Thanks to @Martin Buchmann for posting https://www.informatimago.com/articles/cl-types/ which I used to get started.

Step 1: Set up a hashtable.

(defvar *type-hash* (make-hash-table))

Step 2: Define valid type predicate function. On SBCL, * returns TRUE for a valid type specifier...so we just exclude that particular case and use a handler-case to stop the program raising a condition on the non-valid type-designators.

(defun valid-type-p (type-designator)
  (handler-case (and (SB-EXT:VALID-TYPE-SPECIFIER-P type-designator)
                     (not (eq type-designator 'cl:*)))))

Step 3: We extract the external symbols from the :cl package, which is to say, essentially common lisp the language. We use our valid-type-p predicate to test each symbol. If its valid, we push it onto our collection called types.

Note: :cl isn't the only package you can do this on. If you do this on your own authored package that also uses the external cl symbols, plus defines some of your own exported custom CLOS classes, i think this also captures the class hierarchy contained therein. I haven't tested it too much, so play around. I've avoided this in my example, due to the fact that I believe CLOS hierarchies and classes can change at run time, which might make your hierarchy invalid unless you recalculate it each time, whereas I'm pretty confident the internal types will be the ones most useful for my purposes for now and won't change.

Using each valid type as a key, and using a nested loop, after this operation each key in the hash will now give us a list of types of which that key is a valid sub-type.

(let ((types nil))
  (do-external-symbols (s :cl)
    (when (ignore-errors (valid-type-p s))
      (push s types)))

  (loop for type1 in types
     do (loop for type2 in types
           do (if (subtypep type1 type2)
                  (push type2 (gethash type1 *type-hash*))))))

Step 4: We define a function to give us the most specific super-type of two types. How does that work?

First, we get the intersection of the super-types obtained using our newly populated hash.

Second, we sort the intersection, using subtypep as the sort predicate. The use of subtypep certainly wasn't an intuitive sort predicate for me, until I realised it kind of makes sense to use it to sort a heirarchy. I'm still not 100% sure there aren't some edge cases though :\

Regardless, we'll be returned a list of the intersection of supertypes with a lowly ranked type in the first position, and to get it, we simply take the car

(defun supertype-of-types (type1 type2)
  (car
   (sort
    (intersection (gethash type1 *type-hash*)
                  (gethash type2 *type-hash*))
    #'subtypep)))

Step 5: Supertype-of-types is already a helpful function, but eventually we want to use this on actual values, not just manually entered symbols representing types.

The function type-of appears to return relatively specific types of values in SBCL, but in practice it can return lists. So we need to write a quick function to extract the symbol representing the type from the first part of the list if this happens...

(defun type-of-object (x)
  (let ((type (type-of x)))
    (if (listp type)
        (car type)
        type)))

Step 6: Finally, we write our desired function. We first explicitly check whether one of the two objects is a subtype of the type of the other object. If it is, that's the most specific supertype. We do this partly because SBCL returns types of objects more specific than that just represented just by the type symbols when an object is interrogated with typeof. For my optimisation purposes, i'd like to be able to use these more specific type-specifications if possible, and this is a quick kludge that gets some of those before I figure out extended type specifiers explicitly. If i don't put it in, our next technique returns 'INTEGER as the most-specific supertype for 459 and -345, because SBCL returns (INTEGER 0 4611686018427387903) for the type of 459 and fixnum for the type of -345, the most common super-type would be returned as INTEGER, whereas they are both actually of the specific type fixnum.

Anyway, if the type of one value isn't a subtype of the other value's type, we use our super-type-of-types function created in step 5, and we can always return T as a worst case scenario, because everything is a subtype of type T.

(defun most-specialised-supertype (x y)
  (let ((typex (type-of x))
        (typey (type-of y)))
    (cond ((subtypep typex typey) typey)
          ((subtypep typey typex) typex) 
          ((supertype-of-types (type-of-object x) (type-of-object y)))
          (t t))))

And taking it for a few test spins:

(most-specialised-supertype 5.0l0 435789)
REAL

(most-specialised-supertype 1.0s0 1.0l0)
FLOAT

(most-specialised-supertype 1.0 #c(1 1))
NUMBER

(most-specialised-supertype 'symbol "string")
ATOM

(most-specialised-supertype #(1 2 3) #*101)
VECTOR

I believe it at least looks like its kinda working :)