Wed Jul 8 16:56:52 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* SBCL: compile time overload resolution

--- old-smoke/src/using-type.lisp 2014-10-30 08:13:20.000000000 +0100

+++ new-smoke/src/using-type.lisp 2014-10-30 08:13:20.000000000 +0100

@@ -17,8 +17,7 @@

(defun typep-using-type (object-type type)

"Returns true when OBJECT-TYPE is a subtype of TYPE,

-false when it is not; and :MAYBE when the relationship

-could not be determined."

+false when it is not."

(declare (values (member t nil :maybe)))

(multiple-value-bind (subtype-p valid-p)

(subtypep object-type type)

@@ -30,7 +29,10 @@

(if subtype-p

(throw 'unspecific-type (values object-type type))

(if valid-p

- nil

+ (if (and (subtypep type 'integer)

+ (not (integer-types-disjunct-p object-type type)))

+ (throw 'unspecific-type (values object-type type))

+ nil)

(throw 'unspecific-type (values object-type type)))))

(throw 'unspecific-type (values object-type))))))

@@ -57,7 +59,6 @@

(with-object-as-object ,object

(defun ,name ,lambda-list

,@body))

- #+nil

(with-object-as-type ,object

(defun ,(symbolicate name '-using-type) ,lambda-list

,@body))))

@@ -72,7 +73,6 @@

`(function ,name)))

(defun ,name ,lambda-list

,@body))

- #+nil

(macrolet ((call-using-types (function-name &rest args)

`(,(symbolicate function-name '-using-types)

,@args))

@@ -84,3 +84,8 @@

`(function ,(symbolicate name '-using-types))))

(defun ,(symbolicate name '-using-types) ,lambda-list

,@body))))

+

+(defun integer-types-disjunct-p (type1 type2)

+ ;; FIXME implement this

+ (declare (ignore type1 type2))

+ nil)