Port to ECL

Author: metawilm

runtime/classes.lisp

@@ -817,6 +817,7 @@ otherwise work well.")
     (excl::dump-lisp-source x)))
 
 (defmethod py-function-name ((x function))
+  (declare (ignorable x))
   #+allegro (format nil "~A" (excl::func_name x))
   #-allegro (call-next-method))
 
@@ -3171,27 +3172,32 @@ invocation form.\"")
 (defgeneric py-class-of (x)
 
   ;; Lisp objects lead to their proxy class
-  (:method ((x hash-table)) (ltv-find-class 'dict))
-  (:method ((x integer)) (ltv-find-class 'py-int    ))
-  (:method ((x real))    (ltv-find-class 'py-float  ))
-  (:method ((x complex)) (ltv-find-class 'py-complex))
-  (:method ((x string))  (ltv-find-class 'py-string ))
-  (:method ((x vector))  (ltv-find-class 'py-list   ))
+  (:method ((x hash-table)) (declare (ignorable x)) (ltv-find-class 'dict))
+  (:method ((x integer)) (declare (ignorable x)) (ltv-find-class 'py-int    ))
+  (:method ((x real))    (declare (ignorable x)) (ltv-find-class 'py-float  ))
+  (:method ((x complex)) (declare (ignorable x)) (ltv-find-class 'py-complex))
+  (:method ((x string))  (declare (ignorable x)) (ltv-find-class 'py-string ))
+  (:method ((x vector))  (declare (ignorable x)) (ltv-find-class 'py-list   ))
   (:method ((x list))    (cond ((null x)
                                 (break "PY-CLASS-OF of NIL"))
                                ((and (listp (car x)) (symbolp (caar x)))
                                 (ltv-find-class 'py-alist))
                                (t
                                 (ltv-find-class 'py-tuple))))
-  (:method ((x symbol))  (ltv-find-class 'py-symbol ))
-  (:method ((x function))    (ltv-find-class 'py-function))
-  (:method ((x py-function)) (ltv-find-class 'py-function))
-  (:method ((x package)) (ltv-find-class 'lisp-package))
+  (:method ((x symbol))  (declare (ignorable x))
+                         (ltv-find-class 'py-symbol ))
+  (:method ((x function))    (declare (ignorable x))
+                             (ltv-find-class 'py-function))
+  (:method ((x py-function)) (declare (ignorable x))
+                             (ltv-find-class 'py-function))
+  (:method ((x package))     (declare (ignorable x))
+                             (ltv-find-class 'lisp-package))
 
   #+(or)(:method ((x py-type)) (ltv-find-class 'py-type))
 
   (:method ((x py-meta-type)) ;; metatypes (including `type')
                               ;;  fake being of type `type'
+                              (declare (ignorable x))
                               (ltv-find-class 'py-type))
 
   (:method ((x py-type)) (class-of x))
@@ -3341,12 +3347,12 @@ finished; F will then not be called again."
   ;; XXX Speed up slot value lookup by using
   ;; MOP:SLOT-DEFINITION-LOCATION, MOP:STANDARD-INSTANCE-ACCESS.
   (:method ((f null) &rest args)
-           (declare (ignore args) (dynamic-extent args))
+           (declare (ignore args) (ignorable f) (dynamic-extent args))
 	   (error "PY-CALL of NIL"))
 
   (:method ((f class) &rest args)
            (declare (dynamic-extent args)
-                    (ignorable args)
+                    (ignorable f args)
                     (optimize (speed 3) (safety 0) (debug 0)))
            #-clpython-exceptions-are-python-objects
            (when (subtypep f '{Exception})
@@ -4025,6 +4031,7 @@ Returns one of (-1, 0, 1): -1 iff x < y; 0 iff x == y; 1 iff x > y")
         (setf (get x 'py-hash) hash))))
 
 (defmethod py-repr ((x (eql nil)))
+  (declare (ignorable x))
   "#<the symbol NIL>")
 
 #|| 

runtime/dictattr.lisp

@@ -68,19 +68,25 @@
   #+allegro 'excl::name
   #+ccl 'ccl::name
   #+cmu 'pcl::name
+  #+ecl 'clos::name
   #+lispworks 'clos::name
   #+sbcl 'sb-pcl::name
-  #-(or allegro ccl cmu lispworks sbcl) 
+  #-(or allegro ccl cmu ecl lispworks sbcl) 
   (break "Define slot name containing class name, for this implementation."))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+
+  (defconstant +use-standard-instance-access+
+    #+ #1=ecl nil
+    #+ #2=(or allegro ccl cmu lispworks sbcl) t
+    #- (or #1# #2#) (break "Define +use-standard-instance-access+"))
+
+  (register-feature :clpython-use-standard-instance-access +use-standard-instance-access+)
+
   (defconstant +use-standard-instance-access-setf+
-    #+allegro t
-    #+ccl t
-    #+cmu nil ;; CMUCL lacks (SETF PCL:STANDARD-INSTANCE-ACCESS)
-    #+lispworks t
-    #+sbcl t
-    #-(or allegro ccl cmu lispworks sbcl) (error "Define +use-standard-instance-access-setf+ ~
+    #+(or allegro ccl lispworks sbcl) t
+    #+(or cmu ecl) nil ;; these lack (SETF STANDARD-INSTANCE-ACCESS)
+    #-(or allegro ccl cmu ecl lispworks sbcl) (break "Define +use-standard-instance-access-setf+ ~
 for this implementation"))
 
   (register-feature :clpython-use-standard-instance-access-setf +use-standard-instance-access-setf+))
@@ -109,15 +115,23 @@ for this implementation"))
 
 (defun class.raw-dict (class)
   "Given a class, return its dict. Only intended for classes corresponding to Python (meta)types."
-  (#.+standard-instance-access-func+ class +py-class-dict-slot-index+))
+  #+clpython-use-standard-instance-access
+  (#.+standard-instance-access-func+ class +py-class-dict-slot-index+)
+  #-clpython-use-standard-instance-access
+  (slot-value class 'dict))
 
+#+clpython-use-standard-instance-access
 (define-compiler-macro class.raw-dict (class)
   `(#.+standard-instance-access-func+ ,class +py-class-dict-slot-index+))
 
 (defun class.raw-classname (class)
   "Given a class, return its classname. Only intended for classes corresponding to Python (meta)types."
-  (#.+standard-instance-access-func+ class +py-class-classname-slot-index+))
+  #+clpython-use-standard-instance-access
+  (#.+standard-instance-access-func+ class +py-class-classname-slot-index+)
+  #-clpython-use-standard-instance-access
+  (slot-value class +py-class-classname-slot-name+))
 
+#+clpython-use-standard-instance-access
 (define-compiler-macro class.raw-classname (class)
   `(#.+standard-instance-access-func+ ,class +py-class-classname-slot-index+))
 

runtime/metaclass.lisp

@@ -27,7 +27,7 @@
   nil)
 
 (defgeneric has-dict (x)
-  (:method ((x dict-mixin)) t)
+  (:method ((x dict-mixin)) (declare (ignorable x)) t)
   (:method (x)              (declare (ignore x)) nil))
 
 (defclass py-meta-type (dict-mixin standard-class)