Wed May 27 14:20:30 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix some warnings
diff -rN -u old-smoke/smoke.mbd new-smoke/smoke.mbd
--- old-smoke/smoke.mbd 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/smoke.mbd 2014-09-28 09:40:38.000000000 +0200
@@ -45,8 +45,8 @@
(:objects module
(:needs "smoke-c" "utils")
(:serial t)
- (:components "object" "enum" "method" "class"
- "type" "instance" "stack"))
+ (:components "object" "enum" "type" "method" "class"
+ "instance" "stack"))
(:smoke-c module
(:needs "package" "translate")
(:components ("libsmoke-c" cmake-library)
diff -rN -u old-smoke/src/class-map.lisp new-smoke/src/class-map.lisp
--- old-smoke/src/class-map.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/class-map.lisp 2014-09-28 09:40:38.000000000 +0200
@@ -25,8 +25,7 @@
(defun add-id (smoke-class class)
"Associates the CLOS class CLASS with SMOKE-CLASS."
- (declare (smoke-class smoke-class)
- (smoke-standard-class class))
+ (declare (smoke-class smoke-class))
(setf (gethash (id smoke-class)
(id-class-map (smoke smoke-class)))
class))
diff -rN -u old-smoke/src/objects/method.lisp new-smoke/src/objects/method.lisp
--- old-smoke/src/objects/method.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/objects/method.lisp 2014-09-28 09:40:38.000000000 +0200
@@ -131,9 +131,6 @@
(name (get-class method))
(signature method)))
-(defgeneric get-flag (object flag)
- (:documentation "Returns the value for FLAG of OBJECT."))
-
(defmethod get-flag ((method smoke-method) flag)
(logand (method-slot-value method 'flags)
(foreign-enum-value 'smoke-method-flags flag)))
diff -rN -u old-smoke/src/objects/stack.lisp new-smoke/src/objects/stack.lisp
--- old-smoke/src/objects/stack.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/objects/stack.lisp 2014-09-28 09:40:38.000000000 +0200
@@ -11,6 +11,7 @@
:documentation "Pointer to push the next argument to."))
(:documentation "Contains the argument passed to a Smoke method."))
+(defgeneric size (object))
(defmethod size ((stack call-stack))
"Returns the size (number of arguments) of STACK."
(/
diff -rN -u old-smoke/src/objects/type.lisp new-smoke/src/objects/type.lisp
--- old-smoke/src/objects/type.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/objects/type.lisp 2014-09-28 09:40:38.000000000 +0200
@@ -36,6 +36,9 @@
(= (id type1)
(id type2))))
+(defgeneric get-flag (object flag)
+ (:documentation "Returns the value for FLAG of OBJECT."))
+
(defmethod get-flag ((type smoke-type) flag)
(logand (type-slot-value type 'flags)
#xF0 ;; = ! 0x0F
@@ -57,9 +60,10 @@
"Returns T when TYPE is a pointer ('type*'); NIL otherwise."
(= (get-allocation-flag type) (get-flag type :pointer)))
-(defmethod const-p ((type smoke-type))
- "Returns T when TYPE is const; NIL otherwise."
- (/= 0 (get-flag type :const)))
+(defgeneric const-p (object)
+ (:method ((type smoke-type))
+ "Returns T when TYPE is const; NIL otherwise."
+ (/= 0 (get-flag type :const))))
(defun class-p (type)
"Returns T when TYPE is a smoke class"
diff -rN -u old-smoke/src/overload-resolution.lisp new-smoke/src/overload-resolution.lisp
--- old-smoke/src/overload-resolution.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/overload-resolution.lisp 2014-09-28 09:40:38.000000000 +0200
@@ -440,17 +440,15 @@
(defun+using-type constructor-conversion object (object type)
(when (class-p type)
(let ((to-class (find-smoke-class (get-class type))))
- (multiple-value-bind (method sequence)
- (call-using-types find-best-viable-function2
- (if (using-typep)
- #'standard-conversion-sequence-using-types
- #'standard-conversion-sequence)
- (format nil "~A" (name (get-class type)))
- (list object) to-class)
- (when method
+ (when (call-using-types find-best-viable-function2
+ (if (using-typep)
+ #'standard-conversion-sequence-using-types
+ #'standard-conversion-sequence)
+ (format nil "~A" (name (get-class type)))
+ (list object) to-class)
(make-match 'user-conversion
- 'coerce-to-class
- to-class))))))
+ 'coerce-to-class
+ to-class)))))
(defun call-sequence (method object sequence &rest args)
(s-call method object
diff -rN -u old-smoke/src/smoke.lisp new-smoke/src/smoke.lisp
--- old-smoke/src/smoke.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/smoke.lisp 2014-09-28 09:40:38.000000000 +0200
@@ -89,9 +89,9 @@
(setf pointer (null-pointer)))
(defun delete-object (object)
- (let ((method-name (concatenate 'string "~" (name object))))
+ (let ((method-name (concatenate 'string "~" (name (class-of object)))))
(s-call
- (make-smoke-method object method-name)
+ (make-smoke-method (class-of object) method-name)
(pointer object)))
(setf (slot-value object 'pointer) (null-pointer)))
diff -rN -u old-smoke/src/translate.lisp new-smoke/src/translate.lisp
--- old-smoke/src/translate.lisp 2014-09-28 09:40:37.000000000 +0200
+++ new-smoke/src/translate.lisp 2014-09-28 09:40:37.000000000 +0200
@@ -22,5 +22,6 @@
;(defmethod convert-to-class (smoke-class (pointer cffi:foreign-pointer))
(defmethod convert-to-class (smoke-class pointer)
+ (declare (ignore smoke-class))
(assert (cffi:pointerp pointer))
pointer)