[int][change][fix] with-remote-objects now return a wrapper

This means that it can now be more robust in the face of reference counts and
garbage collection.

src/callpython.lisp

@@ -4,7 +4,7 @@
   "Ensures that all values returned by python functions
 and methods are kept in python, and only pointers are returned to lisp.
 This is useful if performing operations on large datasets."
-  `(thread-global-let ((*in-with-remote-objects-p* t))
+  `(thread-global-let ((*pyobject-translation-mode* :wrapper))
      ,@body))
 
 (defmacro with-remote-objects* (&body body)
@@ -13,8 +13,8 @@ and methods are kept in python, and only handles returned to lisp.
 This is useful if performing operations on large datasets. Unlike
 with-remote-objects, evaluates the last result and returns not just a handle."
   `(with-pygc
-     (thread-global-let ((*in-with-remote-objects-p* nil))
-       (lispify (with-remote-objects ,@body)))))
+     (thread-global-let ((*pyobject-translation-mode* :lisp))
+       (lispify (pyobject-wrapper-pointer (with-remote-objects ,@body))))))
 
 (defun pythonize-args (lisp-args)
   (loop :for arg :in lisp-args
@@ -34,18 +34,26 @@ with-remote-objects, evaluates the last result and returns not just a handle."
 (defun %pycall-return-value (return-value)
   (declare (optimize speed))
   (with-python-exceptions
-    ;; FIXME: Why did we write it this way?
-    (let ((lispified-return-value (if (typep return-value 'foreign-pointer)
-                                      (lispify return-value)
-                                      return-value)))
-      lispified-return-value)))
+    (if (typep return-value 'foreign-pointer)
+        (lispify return-value)
+        return-value)))
 
-;; %PYCALL and %PYCALL* take a pointer to callable as the argument
-;; but the rest of the arguments can be lisp objects and need not be pointers.
+;; %PYCALL and %PYCALL* take a pointer to callable as the argument.
+;; %PYCALL* and PYCALL* return a pointer to the return value
+;;   without wrapping or lispifying it.
+;; The arguments to all the four variants can be lisp objects
+;;   and need not be pointers.
 
+(declaim (ftype (function (foreign-pointer &rest t)
+                          (values foreign-pointer &optional))
+                %pycall*))
 (defun %pycall* (python-callable-pointer &rest args)
+  "Fastest (non compile-time) variant of PYCALL.
+It takes in a foreign-pointer to a python callable and returns a foreign pointer to the return value which is a pyobject."
   (declare (type foreign-pointer python-callable-pointer)
            (optimize speed))
+  ;; It is not appropriate to use PYGC here.
+  ;; We expect the task of GC-ing to be performed by higher level functions.
   (labels ((pin-and-call (&rest rem-args)
              (cond ((null rem-args)
                     (let ((pythonized-args (pythonize-args args)))
@@ -71,28 +79,34 @@ with-remote-objects, evaluates the last result and returns not just a handle."
 
 (defun %pycall (python-callable-pointer &rest args)
   (declare (type foreign-pointer python-callable-pointer))
-  (if *in-with-remote-objects-p*
-      (apply #'%pycall* python-callable-pointer args)
-      (with-pygc
-        ;; We can't just rely on %PYCALL* because we also need to deal with
-        ;; PYTHONIZED-ARGS while lispifying the values
-        (let ((pythonized-args (pythonize-args args)))
-          (multiple-value-bind (pos-args kwargs)
-              (args-and-kwargs pythonized-args)
-            ;; PyObject_Call returns a new reference
-            (let* ((return-value (pyforeign-funcall "PyObject_Call"
-                                                    :pointer python-callable-pointer
-                                                    :pointer pos-args
-                                                    :pointer kwargs
-                                                    :pointer)))
-              ;; If the RETURN-VALUE is an array amongst the inputs,
-              ;; then avoid lispifying the return-value
-              (mapc (lambda (pyarg arg)
-                      (when (and (arrayp arg)
-                                 (pointer-eq pyarg return-value))
-                        (setq return-value arg)))
-                    pythonized-args args)
-              (%pycall-return-value return-value)))))))
+  (ecase *pyobject-translation-mode*
+    (:foreign-pointer (apply #'%pycall* python-callable-pointer args))
+    (:wrapper
+     (let ((pyobject-pointer (apply #'%pycall* python-callable-pointer args)))
+       (pyuntrack pyobject-pointer)
+       (make-tracked-pyobject-wrapper
+        (apply #'%pycall* python-callable-pointer args))))
+    (:lisp
+     (with-pygc
+       ;; We can't just rely on %PYCALL* because we also need to deal with
+       ;; PYTHONIZED-ARGS while lispifying the values
+       (let ((pythonized-args (pythonize-args args)))
+         (multiple-value-bind (pos-args kwargs)
+             (args-and-kwargs pythonized-args)
+           ;; PyObject_Call returns a new reference
+           (let* ((return-value (pyforeign-funcall "PyObject_Call"
+                                                   :pointer python-callable-pointer
+                                                   :pointer pos-args
+                                                   :pointer kwargs
+                                                   :pointer)))
+             ;; If the RETURN-VALUE is an array amongst the inputs,
+             ;; then avoid lispifying the return-value
+             (mapc (lambda (pyarg arg)
+                     (when (and (arrayp arg)
+                                (pointer-eq pyarg return-value))
+                       (setq return-value arg)))
+                   pythonized-args args)
+             (%pycall-return-value return-value))))))))
 
 (labels ((pythonizep (value)
            "Determines if VALUE should be pythonized."
@@ -133,7 +147,7 @@ python callable, which is then retrieved using PYVALUE*"
                  (python-name
                   (pyvalue* python-callable))
                  (string
-                  (with-remote-objects (raw-pyeval python-callable)))
+                  (raw-py #\e python-callable))
                  (symbol
                   (pyvalue* (pythonize-symbol python-callable)))
                  (pyobject-wrapper
@@ -144,14 +158,24 @@ python callable, which is then retrieved using PYVALUE*"
         (error "Python function ~A is not defined" python-callable)
         (apply #'%pycall* pyfun args))))
 
+(declaim (inline pyobject-pointer-translate))
+(defun pyobject-pointer-translate (pyobject-pointer)
+  (declare (optimize speed)
+           (type foreign-pointer pyobject-pointer))
+  (ecase *pyobject-translation-mode*
+    (:foreign-pointer pyobject-pointer)
+    (:wrapper
+     (pyuntrack pyobject-pointer)
+     (make-tracked-pyobject-wrapper pyobject-pointer))
+    (:lisp
+     (with-pygc (%pycall-return-value pyobject-pointer)))))
+
 (defun pycall (python-callable &rest args)
   "If PYTHON-CALLABLE is a string or symbol, it is treated as the name of a
 python callable, which is then retrieved using PYVALUE*"
   (declare (optimize speed))
   (python-start-if-not-alive)
-  (if *in-with-remote-objects-p*
-      (apply #'pycall* python-callable args)
-      (with-pygc (%pycall-return-value (apply #'pycall* python-callable args)))))
+  (pyobject-pointer-translate (apply #'pycall* python-callable args)))
 
 (defun pyslot-value* (object slot-name)
   (let* ((object-pointer (%pythonize object))
@@ -162,9 +186,7 @@ python callable, which is then retrieved using PYVALUE*"
   (declare (type (or symbol string) slot-name)
            (optimize debug))
   (python-start-if-not-alive)
-  (if *in-with-remote-objects-p*
-      (pyslot-value* object slot-name)
-      (with-pygc (%pycall-return-value (pyslot-value* object slot-name)))))
+  (pyobject-pointer-translate (pyslot-value* object slot-name)))
 
 (defun (setf pyslot-value) (new-value object slot-name)
   (python-start-if-not-alive)

src/lispifiers.lisp

@@ -151,7 +151,7 @@
 (defun lispify (pyobject)
   (declare (type foreign-pointer pyobject)
            (optimize speed))
-  (assert (null *in-with-remote-objects-p*))
+  (assert (eq :lisp *pyobject-translation-mode*))
   (let* ((pyobject-type (pyforeign-funcall "PyObject_Type"
                                            :pointer pyobject
                                            :pointer))

src/package.lisp

@@ -24,7 +24,6 @@
 
            #:pythonize
            #:pyobject-wrapper
-           #:pyobject-wrapper-type
            #:pyobject-wrapper-eq
            #:pyobject-wrapper-eq*
            #:define-lispifier

src/python-process.lisp

@@ -4,7 +4,10 @@
 ;; Multithreading reference: https://www.linuxjournal.com/article/3641
 
 (defvar *python-libraries-loaded-p* nil)
-(defvar *in-with-remote-objects-p* nil)
+
+(declaim (type (member :foreign-pointer :wrapper :lisp)
+               *pyobject-translation-mode*))
+(defvar *pyobject-translation-mode* :lisp)
 
 (defvar *python-state* :uninitialized)
 (declaim (type (member :uninitialized :initialized :initializing) *python-state*))
@@ -233,8 +236,8 @@ will be executed by PYSTART.")
       (when (pygil-held-p)
         (warn "Python GIL was not released from the main thread. This means on implementations (like SBCL) that call lisp object finalizers from a separate thread may never get a chance to run, and thus python foreign objects associated with PYOBJECT-WRAPPER
 can lead to memory leak.")))
-    (import-module "sys")
     (import-module "traceback")
+    (import-module "sys")
     (when *numpy-installed-p*
       (float-features:with-float-traps-masked (:overflow :invalid)
         (ignore-some-conditions (floating-point-overflow floating-point-invalid-operation)
@@ -330,7 +333,7 @@ from inside PYTHON-MAY-BE-ERROR does not lead to an infinite recursion.")
                                                                          :pointer)
                                              :pointer)))
                        (traceback-str
-                         (let ((*in-with-remote-objects-p* nil))
+                         (let ((*pyobject-translation-mode* :lisp))
                            (if (null-pointer-p traceback)
                                (pycall "traceback.format_exception_only" type value)
                                (pycall "traceback.format_exception" type value traceback)))))
@@ -395,9 +398,7 @@ PYEVAL, PYEXEC should be avoided unless necessary.
 Instead, use PYCALL, PYVALUE, (SETF PYVALUE), PYSLOT-VALUE, (SETF PYSLOT-VALUE), and PYMETHOD.
 
 RAW-PY, RAW-PYEVAL, RAW-PYEXEC are only provided for backward compatibility."
-  (if *in-with-remote-objects-p*
-      (apply #'raw-py #\e code-strings)
-      (with-pygc (lispify (apply #'raw-py #\e code-strings)))))
+  (pyobject-pointer-translate (apply #'raw-py #\e code-strings)))
 
 (defun raw-pyexec (&rest code-strings)
   "
@@ -533,6 +534,7 @@ Use PYVALUE* if you want to refer to names containing full-stops."
            (type foreign-pointer new-value))
   (python-start-if-not-alive)
   (if (pyobject-wrapper-p python-value-or-variable)
+      ;; FIXME
       python-value-or-variable
       (let (value previous-value previous-name)
         (do-subseq-until (name python-value-or-variable #\. :test #'char=)
@@ -563,9 +565,7 @@ Example:
 "
   (declare (type (or pyobject-wrapper string) python-name-or-variable))
   (python-start-if-not-alive)
-  (if *in-with-remote-objects-p*
-      (pyvalue* python-name-or-variable)
-      (with-pygc (lispify (pyvalue* python-name-or-variable)))))
+  (pyobject-pointer-translate (pyvalue* python-name-or-variable)))
 
 (defun (setf pyvalue) (new-value python-name-or-variable)
   "Set the value of a python-name-or-variable.

src/pythonizers.lisp

@@ -39,7 +39,7 @@ a New Reference"
 (defvar *print-pyobject* t
   "If non-NIL, python's 'str' is called on the python-object before printing.")
 
-(defvar *print-pyobject-wrapper-identity* nil
+(defvar *print-pyobject-wrapper-identity* t
   "If non-NIL, print's the lisp type and identity of the pyobject-wrapper.")
 
 (defun pyobject-wrapper-eq (o1 o2)
@@ -59,34 +59,37 @@ the same lisp objects which are EQ to each other. Returns NIL in all other cases
 
 (defmethod print-object ((o pyobject-wrapper) s)
   (with-pygc
-    (let* ((pointer (pyobject-wrapper-pointer o)))
-      (flet ((type ()
-               (let ((may-be-type (pyforeign-funcall "PyObject_Type"
-                                                     :pointer pointer
-                                                     :pointer)))
-                 (ensure-non-null-pointer may-be-type)
-                 (lispify
-                  (pyforeign-funcall "PyObject_Str"
-                                     :pointer may-be-type
-                                     :pointer)))))
-        (if *print-pyobject-wrapper-identity*
-            (print-unreadable-object (o s :type t :identity t)
-              (if *print-pyobject*
-                  (progn
-                    (format s ":type ~A~%" (type))
-                    (pprint-logical-block (s nil :per-line-prefix "  ")
-                      (write-string (lispify (pyforeign-funcall "PyObject_Str"
-                                                                :pointer pointer
-                                                                :pointer))
-                                    s))
-                    (terpri s))
-                  (format s ":POINTER ~A :TYPE ~A" pointer (type))))
+    (let* ((pointer (pyobject-wrapper-pointer o))
+           (type (let ((may-be-type (pyforeign-funcall "PyObject_Type"
+                                                       :pointer pointer
+                                                       :pointer)))
+                   (ensure-non-null-pointer may-be-type)
+                   (lispify
+                    (pyforeign-funcall "PyObject_Str"
+                                       :pointer may-be-type
+                                       :pointer)))))
+      (if *print-pyobject-wrapper-identity*
+          (print-unreadable-object (o s :type t :identity t)
             (if *print-pyobject*
-                (write-string (lispify (pyforeign-funcall "PyObject_Str"
-                                                          :pointer pointer
-                                                          :pointer))
-                              s)
-                (format s ":POINTER ~A :TYPE ~A" pointer (type))))))))
+                (progn
+                  (format s ":type ~A~%" type)
+                  (pprint-logical-block (s nil :per-line-prefix "  ")
+                    (format s (if (string= "<class 'str'>" type)
+                                  "\"~A\""
+                                  "~A")
+                            (lispify (pyforeign-funcall "PyObject_Str"
+                                                        :pointer pointer
+                                                        :pointer))))
+                  (terpri s))
+                (format s ":POINTER ~A :TYPE ~A" pointer type)))
+          (if *print-pyobject*
+              (format s (if (string= "<class 'str'>" type)
+                            "\"~A\""
+                            "~A")
+                      (lispify (pyforeign-funcall "PyObject_Str"
+                                                  :pointer pointer
+                                                  :pointer)))
+              (format s ":POINTER ~A :TYPE ~A" pointer type))))))
 
 (defmethod make-load-form ((o pyobject-wrapper) &optional env)
   (with-slots (pointer load-form) o
@@ -212,7 +215,7 @@ takes place."))
 (defcallback lisp-callback-fn :pointer ((handle :int) (args :pointer) (kwargs :pointer))
   (declare (optimize debug))
   (with-pygc
-    (thread-global-let ((*in-with-remote-objects-p* nil))
+    (thread-global-let ((*pyobject-translation-mode* :lisp))
       (handler-case
           (let ((lisp-callback (lisp-object handle)))
             (pythonize (apply lisp-callback