In general lisp, what is a function that returns the most specific supertype of two objects?
I'm most interested in the applicability to SBCL, but I'm also interested in other Common Lisp implementations as well.
In Common Lisp, we have a type hierarchy .
I need a function that, when given two objects as parameters, returns a character denoting the most specific supertype applicable to those two objects. Its use would look something like this:
(most-specific-super-type x y)
So, for example, short-float and long-float are subtypes of supertype float
.
If a long float and an integer were compared, the most specific supertype is real
.
And if a complex number and a float were compared, the most specific supertype is number
.
By comparing two objects with separate trees in a hierarchy of that type, we are supposedly returning a type, T
or perhaps atom
in the event that the object is not cons
.
I wish I didn't have to write this myself, and my gut tells me that it looks like the function already 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 that for CLOS classes to define a priority class.
So if there was a function that applies to classes and types together, that would be great, but I would be glad if there was a type-only solution ...
source to share
As I think it will be useful for others and I could not find such a solution anywhere after a thorough search and I didn’t have too many bites, I was in hacking the basic unoptimized logic to solve it myself.
This is not a final working version, but should get someone else to look for the same problem for a solution, after which they can solidify and refactor. Please comment and suggest any fixes / 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 hash table.
(defvar *type-hash* (make-hash-table))
Step 2: Define a valid type predicate function. In SBCL, it *
returns TRUE for a valid type specifier ... so we just rule out this particular case and use a handler to stop the program from raising the condition on invalid type pointers.
(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 are extracting external symbols from the package :cl
, which is essentially a common lisp language. We use our predicate valid-type-p
to test each character. If it is valid, we push it to our collection called types
.
Note. :cl
- this is not the only package on which you can do this. If you do this in your own authoring package, which also uses external cl symbols, and also defines some of your own exported custom CLOS classes, I think this also reflects the class hierarchy it contains. I haven't tested too much, so play it. I avoided this in my example due to the fact that I believe that CLOS hierarchies and classes can change at runtime, which could cause your hierarchy to be invalid if you don't recalculate it every time, whereas I I'm sure that the internal types will be the ones that are useful for my purposes at the moment and will not change.
Using every valid type as a key and using a nested loop, after this operation, every key in the hash will now provide us with a list of types for which this key is a valid subtype.
(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 that gives us the most specific supertype of two types. How it works?
First, we get the intersection
supertypes obtained using our newly populated hash.
Second, we sort the intersection using it subtypep
as a sort predicate. Usage subtypep
, of course, was not an intuitive sort predicate for me until I realized that it made sense to use it to sort the hierarchy. I'm still not 100% sure that there are no edge cases: \
Regardless, we will be returned a low ranking supertype intersection list in the first position, and to get it we simply take car
(defun supertype-of-types (type1 type2)
(car
(sort
(intersection (gethash type1 *type-hash*)
(gethash type2 *type-hash*))
#'subtypep)))
Step 5: Supertype types are already a useful feature, but ultimately we want to use this on the actual values, not just manually typed characters representing the types.
The function type-of
appears to return relatively specific value types in SBCL, but in practice it can return lists. Therefore, we need to write a quick function to extract the character representing the type from the first part of the list if that happens ...
(defun type-of-object (x)
(let ((type (type-of x)))
(if (listp type)
(car type)
type)))
Step 6: Finally, we will write the desired function. First, we explicitly check if one of the two objects is a subtype of the other object's type. If so, then the most specific supertype. We do this in part because SBCL returns object types that are more specific than just represented by type symbols when the object is queried with typeof
. For my optimization purposes, I would like to be able to use these more specific type specifications if possible, and this is a quick kludge that gets some of them before I figure out the extended type specifiers explicitly. If I don't include it, our next technique will return "INTEGER" as the most specific supertype for 459 and -345, because SBCL returns (INTEGER 0 4611686018427387903)
for 459 andfixnum
for type -345, the most common supertype will be returned as INTEGER
, whereas they are both of a particular type fixnum
.
In any case, if the type of one value is not a subtype of another value type, we use our function super-type-of-types
created in step 5, and we can always return T as a worst-case scenario, because it is all 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 let's take it in a few test cycles:
(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 it works :)
source to share