Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix py-dict in ECL

  • Loading branch information...
commit 62d4bcc0210a199e898c62754ad5463b848e7fe3 1 parent da348c8
@metawilm authored
View
24 compiler/compiler.lisp
@@ -164,7 +164,7 @@ ARGS are the command-line args, available as `sys.argv'; can be a string (which
(let ((*habitat* (or habitat (make-habitat))))
(unless module-globals
(setf module-globals (make-eq-hash-table)))
- (check-type module-globals (or hash-table package))
+ (check-type module-globals (or hash-table package #+ecl cl-custom-hash-table::custom-hash-table))
(when args-p
(setf (habitat-cmd-line-args *habitat*) args))
(flet ((run ()
@@ -871,10 +871,11 @@ an assigment statement. This changes at least the returned 'store' form.")
,del-form)))
(defun init-dict (vk-list)
- (let ((dict (make-py-hash-table)))
- (loop for (v k) on vk-list by #'cddr
- do (setf (gethash k dict) v))
- dict))
+ (with-py-dict
+ (let ((dict (make-py-hash-table)))
+ (loop for (v k) on vk-list by #'cddr
+ do (setf (gethash k dict) v))
+ dict)))
(defmacro [dict-expr] (vk-list)
(with-gensyms (list)
@@ -1417,7 +1418,7 @@ LOCALS shares share tail structure with input arg locals."
(multiple-value-bind (module module-new-p)
(ensure-module :src-pathname src-pathname :bin-pathname bin-pathname :name current-module-name)
(let ((%module-globals (module-ht module)))
- (check-type %module-globals hash-table)
+ (check-type %module-globals (or hash-table #+ecl cl-custom-hash-table::custom-hash-table))
(flet ((init-module (&optional (module-globals %module-globals))
(init-module-namespace module-globals current-module-name))
(run-top-level-forms (&optional (module-globals %module-globals))
@@ -1452,7 +1453,7 @@ LOCALS shares share tail structure with input arg locals."
:run-tlv t
:globals %module-globals))
(continue-loading (&key (init t) (run-tlv t) (globals %module-globals))
- (check-type globals hash-table)
+ (check-type globals (or hash-table #+ecl cl-custom-hash-table::custom-hash-table))
(setf %module-globals globals)
(when init
(init-module))
@@ -2313,10 +2314,11 @@ Non-negative integer denoting the number of args otherwise."
;; Create ** arg
(when (fa-**-arg fa)
(setf (svref arg-val-vec (1+ (the fixnum (fa-num-pos-key-args fa))))
- (loop with d = (make-py-hash-table)
- for (k . v) in for-**
- do (setf (gethash (symbol-name k) d) v)
- finally (return d)))))
+ (with-py-dict
+ (loop with d = (make-py-hash-table)
+ for (k . v) in for-**
+ do (setf (gethash (symbol-name k) d) v)
+ finally (return d))))))
(values))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
View
3  compiler/generator.lisp
@@ -354,7 +354,8 @@ former requires that this form is executed within RECEIVE-YIELDED-VALUE."
;; First 1st val is evaluated, then 1st key, then 2nd, etc.
`(with-cps-conversion (,v ,val)
(with-cps-conversion (,k ,key)
- (setf (gethash ,key .dict) ,val)
+ (with-py-dict
+ (setf (gethash ,key .dict) ,val))
,res)))))
`(let ((.dict (make-py-hash-table)))
,res)))
View
44 compiler/namespace.lisp
@@ -306,34 +306,36 @@
(register-feature :clpython-optimize-namespaces *optimize-namespaces*)
(defmethod ns.read-form ((ns hash-table-ns) (s symbol))
- `(or #+clpython-optimize-namespaces
- #1=(get ',s ,(ns.dict-form ns))
- (let ((val (gethash ',s ,(ns.dict-form ns))))
- #+clpython-optimize-namespaces
- (when val
- (setf #1# val))
- val)
- ,(when (ns.parent ns)
- (ns.read-form (ns.parent ns) s))))
+ `(with-py-dict
+ (or #+clpython-optimize-namespaces
+ #1=(get ',s ,(ns.dict-form ns))
+ (let ((val (gethash ',s ,(ns.dict-form ns))))
+ #+clpython-optimize-namespaces
+ (when val
+ (setf #1# val))
+ val)
+ ,(when (ns.parent ns)
+ (ns.read-form (ns.parent ns) s)))))
(defmethod ns.write-form ((ns hash-table-ns) (s symbol) val-form)
- #+clpython-optimize-namespaces
- `(let ((val ,val-form))
- (setf (get ',s ,(ns.dict-form ns)) val
- (gethash ',s ,(ns.dict-form ns)) val))
- #-clpython-optimize-namespaces
- `(setf (gethash ',s ,(ns.dict-form ns)) ,val-form))
+ `(with-py-dict
+ #+clpython-optimize-namespaces (let ((val ,val-form))
+ (setf (get ',s ,(ns.dict-form ns)) val
+ (gethash ',s ,(ns.dict-form ns)) val))
+ #-clpython-optimize-namespaces (setf (gethash ',s ,(ns.dict-form ns)) ,val-form)))
(defmethod ns.write-runtime-form ((ns hash-table-ns) name-form val-form)
- `(let* ((name ,name-form)
- (val ,val-form))
- (setf #+clpython-optimize-namespaces #+clpython-optimize-namespaces
- (get name ,(ns.dict-form ns)) val
- (gethash name ,(ns.dict-form ns)) val)))
+ `(with-py-dict
+ (let* ((name ,name-form)
+ (val ,val-form))
+ (setf #+clpython-optimize-namespaces #+clpython-optimize-namespaces
+ (get name ,(ns.dict-form ns)) val
+ (gethash name ,(ns.dict-form ns)) val))))
(defmethod ns.del-form ((ns hash-table-ns) (s symbol))
`(progn #+clpython-optimize-namespaces (remprop ',s ,(ns.dict-form ns))
- (remhash ',s ,(ns.dict-form ns))))
+ (with-py-dict
+ (remhash ',s ,(ns.dict-form ns)))))
(defmethod ns.locals-form ((ns hash-table-ns))
(ns.dict-form ns))
View
256 runtime/classes.lisp
@@ -725,7 +725,7 @@ otherwise work well.")
(when (eq attr '{__dict__})
(when (typep val 'symbol-hash-table)
(setf val (sht-ht val)))
- (check-type val hash-table)
+ (check-type val hash-table) ;; XXX or custom ht
(let ((ht (make-eq-hash-table)))
(loop for key being the hash-key in val
using (hash-value value)
@@ -1479,7 +1479,7 @@ but the latter two classes are not in CPython.")
(setf bin-file-write-date (file-write-date bin-pathname))))
(when (string= name "__main__")
(setf name (pathname-name (or src-pathname bin-pathname)))))
- (check-type (module-ht m) hash-table)
+ (check-type (module-ht m) hash-table) ;; XXX or custom ht
(setf (gethash m *all-modules*) t))
(defun find-module-fuzzy (x)
@@ -2181,101 +2181,110 @@ But if RELATIVE-TO package name is given, result may contains dots."
items)))))
(def-py-method dict.__delitem__ (dict k)
- (or #-clpython-custom-hash-table-fallback (remhash k dict)
- #+clpython-custom-hash-table-fallback (clpython.custom-hash-table:remhash k dict)
- (py-raise '{KeyError} "Dict ~A has no such key: ~A." dict k)))
+ (with-py-dict
+ (or (remhash k dict)
+ (py-raise '{KeyError} "Dict ~A has no such key: ~A." dict k))))
(def-py-method dict.__eq__ (dict1 dict2)
- #-clpython-custom-hash-table-fallback
- (py-bool (cond ((eq dict1 dict2)
- t)
- ((not (hash-table-p dict2))
- nil)
- ((/= (hash-table-count dict1) (hash-table-count dict2))
- nil)
- (t
- (loop for k being each hash-key in dict1
- using (hash-value v)
- always (py-==->lisp-val (gethash k dict2) v)))))
- #+clpython-custom-hash-table-fallback
- (py-bool (cond ((eq dict1 dict2)
- t)
- ((not (clpython.custom-hash-table:custom-hash-table-p dict2))
- nil)
- ((/= (clpython.custom-hash-table:hash-table-count dict1)
- (clpython.custom-hash-table:hash-table-count dict2))
- nil)
- (t
- (with-keys-values (k v dict1 t)
- (unless (py-==->lisp-val (clpython.custom-hash-table:gethash k dict2) v)
- (return-from with-keys-values nil)))))))
+ (with-py-dict
+ (py-bool (cond ((eq dict1 dict2)
+ t)
+ ((not (hash-table-p dict2))
+ nil)
+ ((/= (hash-table-count dict1) (hash-table-count dict2))
+ nil)
+ (t
+ (with-hash-table-iterator (next dict1)
+ (loop named iter
+ do (multiple-value-bind (entry-p k v) (next)
+ (cond ((not entry-p)
+ (return-from iter t))
+ ((not (py-==->lisp-val (gethash k dict2) v))
+ (return-from iter nil)))))))))))
(def-py-method dict.__getitem__ (dict k)
"KEY may be symbol (converted to string)"
- (or (gethash k dict)
- (py-raise '{KeyError} "Dict ~A has no such key: ~A." dict k)))
+ (with-py-dict
+ (or (gethash k dict)
+ (py-raise '{KeyError} "Dict ~A has no such key: ~A." dict k))))
(def-py-method dict.__iter__ (dict)
(dict.iterkeys dict))
(def-py-method dict.__len__ (dict)
- (hash-table-count dict))
+ (with-py-dict
+ (hash-table-count dict)))
(def-py-method dict.__nonzero__ (dict)
- (py-bool (plusp (hash-table-count dict))))
+ (with-py-dict
+ (py-bool (plusp (hash-table-count dict)))))
(def-py-method dict.__repr__ (x)
- (with-output-to-string (s)
- (write-char #\{ s)
- (loop with hc = (hash-table-count x)
- for key being each hash-key in x
- using (hash-value val)
- for i from 1
- do (repr-fmt s key)
- (write-string ": " s)
- (repr-fmt s val)
- (unless (= i hc)
- (write-string ", " s)))
- (write-char #\} s)))
+ (with-py-dict
+ (with-output-to-string (s)
+ (write-char #\{ s)
+ (with-hash-table-iterator (next x)
+ (loop named iter
+ with first = t
+ do (multiple-value-bind (entry-p key val) (next)
+ (cond ((not entry-p) (return-from iter))
+ (t (cond (first (setf first nil))
+ (t (write-string ", " s)))
+ (repr-fmt s key)
+ (write-string ": " s)
+ (repr-fmt s val))))))
+ (write-char #\} s))))
(def-py-method dict.__setitem__ (x key val)
- (setf (gethash key x) val))
+ (with-py-dict
+ (setf (gethash key x) val)))
(def-py-method dict.clear (d^)
- (clrhash d))
+ (with-py-dict (clrhash d)))
(def-py-method dict.copy (d1)
- (loop with d2 = (make-py-hash-table)
- for k being each hash-key in d1
- using (hash-value v)
- do (setf (gethash k d2) v)
- finally (return d2)))
+ (with-hash-table-iterator (next d1)
+ (loop named iter
+ with d2 = (make-py-hash-table)
+ do (multiple-value-bind (entry-p k v) (next)
+ (cond ((not entry-p) (return-from iter d2))
+ (t (setf (gethash k d2) v)))))))
(def-py-method dict.fromkeys :static (seq &optional (val (load-time-value *the-none*)))
- (let ((d (make-py-hash-table)))
- (map-over-object (lambda (key) (setf (gethash key d) val)) seq)
- d))
+ (with-py-dict
+ (let ((d (make-py-hash-table)))
+ (map-over-object (lambda (key) (setf (gethash key d) val)) seq)
+ d)))
(def-py-method dict.get (x k &optional (default (load-time-value *the-none*)))
- (or (gethash k x) default))
+ (with-py-dict
+ (or (gethash k x) default)))
(def-py-method dict.has_key (x k)
- (multiple-value-bind (val presentp)
- (gethash k x)
- (declare (ignore val))
- (py-bool presentp)))
+ (with-py-dict
+ (multiple-value-bind (val presentp)
+ (gethash k x)
+ (declare (ignore val))
+ (py-bool presentp))))
(def-py-method dict.items (x)
- (make-py-list-from-list
- (loop for k being each hash-key in x using (hash-value v)
- collect (make-tuple-from-list (list k v)))))
+ (with-py-dict
+ (with-hash-table-iterator (next x)
+ (loop named iter
+ with tuples
+ do (multiple-value-bind (entry-p k v) (next)
+ (cond ((not entry-p)
+ (return-from iter (make-py-list-from-list tuples)))
+ (t
+ (push (make-tuple-from-list (list k v)) tuples))))))))
(defparameter *hash-table-iterator-indefinite-extent*
(checking-reader-conditionals
#+allegro t
+ #+ecl t
#+lispworks nil
#+sbcl t
- #-(or allegro lispworks sbcl) nil)
+ #-(or allegro ecl lispworks sbcl) nil)
"Whether the iterator created by WITH-HASH-TABLE-ITERATOR has indefinite extent.
ANSI states for WITH-HASH-TABLE-ITERATOR: \"It is unspecified what happens if any
of the implicit interior state of an iteration is returned outside the dynamic extent
@@ -2288,23 +2297,27 @@ invocation form.\"")
(make-iterator-from-function
:func (lambda () (multiple-value-bind (ok key val) (next-fn)
(when ok (funcall func key val))))))
- (let ((vec (loop with vec = (make-array (* 2 (hash-table-count hash-table)))
- with i = -1
- for key being each hash-key in hash-table
- using (hash-value val)
- do (setf (svref vec (incf i)) key
- (svref vec (incf i)) val)
- finally (return vec)))
- (i 0)
- (count (* 2 (hash-table-count hash-table))))
- (make-iterator-from-function
- :func (lambda ()
- (when (< i count)
- (let ((key (svref vec i))
- (val (svref vec (incf i))))
- (declare (ignorable key val))
- (prog1 (funcall func key val)
- (incf i)))))))))
+ (progn
+ #+custom-hash-table-fallback ;; from library CL-CUSTOM-HASH-TABLE
+ (error "This LOOP is not supported by CUSTOM-HASH-TABLE-FALLBACK")
+ (let ((vec
+ (loop with vec = (make-array (* 2 (hash-table-count hash-table)))
+ with i = -1
+ for key being each hash-key in hash-table
+ using (hash-value val)
+ do (setf (svref vec (incf i)) key
+ (svref vec (incf i)) val)
+ finally (return vec)))
+ (i 0)
+ (count (* 2 (hash-table-count hash-table))))
+ (make-iterator-from-function
+ :func (lambda ()
+ (when (< i count)
+ (let ((key (svref vec i))
+ (val (svref vec (incf i))))
+ (declare (ignorable key val))
+ (prog1 (funcall func key val)
+ (incf i))))))))))
(def-py-method dict.iteritems (x)
(make-dict-iterator x (lambda (k v) (make-tuple-from-list (list k v)))))
@@ -2316,44 +2329,61 @@ invocation form.\"")
(make-dict-iterator x (lambda (k v) (declare (ignore k)) v)))
(def-py-method dict.keys (x)
- (make-py-list-from-list (loop for key being each hash-key in x collect key)))
+ (with-py-dict
+ (with-hash-table-iterator (next x)
+ (loop with keys
+ do (multiple-value-bind (entry-p k v) (next)
+ (declare (ignore v))
+ (cond ((not entry-p)
+ (return-from dict.keys (make-py-list-from-list keys)))
+ (t
+ (push k keys))))))))
(def-py-method dict.pop (x key &optional default)
- (let ((val (gethash key x)))
- (if val
- (prog1 val (remhash key x))
- (or default (py-raise '{KeyError} "Dict has no key `~A' to pop()." key)))))
+ (with-py-dict
+ (let ((val (gethash key x)))
+ (if val
+ (prog1 val (remhash key x))
+ (or default (py-raise '{KeyError} "Dict has no key `~A' to pop()." key))))))
(def-py-method dict.popitem (x)
- (loop for k being each hash-key in x
- using (hash-value v)
- do (remhash k x)
- (return (make-tuple-from-list (list k v)))
- finally (py-raise '{KeyError} "Dict is empty, can not popitem().")))
+ (with-py-dict
+ (maphash (lambda (k v)
+ (remhash k x)
+ (return-from dict.popitem
+ (make-tuple-from-list (list k v))))
+ x))
+ (py-raise '{KeyError} "Dict is empty, can not popitem()."))
(def-py-method dict.setdefault (x key &optional default)
- (or (gethash key x)
- (setf (gethash key x) default)))
+ (with-py-dict
+ (or (gethash key x)
+ (setf (gethash key x) default))))
(def-py-method dict.update (x y &rest kv-items)
- (when (or (keywordp y) (and kv-items (not (keywordp (car kv-items)))))
- (py-raise '{ValueError} "Invalid arguments to dict.update: expected (x, k=v, k2=v2, ..)."))
- (if (hash-table-p y)
- (maphash (lambda (k v) (setf (gethash k x) v)) y)
- (loop for entry in (py-iterate->lisp-list y)
- for subentries = (py-iterate->lisp-list entry)
- do (unless (= (length subentries) 2)
- (py-raise '{ValueError} "Invalid update subentry: expected (k, v), got: ~A." (py-repr-string subentries)))
- (destructuring-bind (key val)
- subentries
- (setf (gethash key x) val))))
- (assert (evenp (length kv-items)))
- (loop for (key val) on kv-items by #'cddr
- do (setf (gethash (symbol-name key) x) val))
+ (with-py-dict
+ (when (or (keywordp y) (and kv-items (not (keywordp (car kv-items)))))
+ (py-raise '{ValueError}
+ "Invalid arguments to dict.update: expected (x, k=v, k2=v2, ..)."))
+ (if (hash-table-p y)
+ (maphash (lambda (k v) (setf (gethash k x) v)) y)
+ (loop for entry in (py-iterate->lisp-list y)
+ for subentries = (py-iterate->lisp-list entry)
+ do (unless (= (length subentries) 2)
+ (py-raise '{ValueError} "Invalid update subentry: expected (k, v), got: ~A."
+ (py-repr-string subentries)))
+ (destructuring-bind (key val)
+ subentries
+ (setf (gethash key x) val))))
+ (assert (evenp (length kv-items)))
+ (loop for (key val) on kv-items by #'cddr
+ do (setf (gethash (symbol-name key) x) val)))
*the-none*)
(def-py-method dict.values (x)
- (make-py-list-from-list (loop for v being the hash-value in x collect v)))
+ ;; XXX should err in ECL
+ (with-py-dict
+ (make-py-list-from-list (loop for v being the hash-value in x collect v))))
;; Dicts used for namespaces
@@ -2365,10 +2395,10 @@ invocation form.\"")
;; Is there a reason to make the mapping unique?
(defun make-symbol-hash-table (ht)
- (check-type ht hash-table)
- (or (gethash ht *ht->symbol-hash-table*)
- (setf (gethash ht *ht->symbol-hash-table*)
- (make-instance 'symbol-hash-table :hash-table ht))))
+ (with-py-dict
+ (or (gethash ht *ht->symbol-hash-table*)
+ (setf (gethash ht *ht->symbol-hash-table*)
+ (make-instance 'symbol-hash-table :hash-table ht)))))
(def-py-method symbol-hash-table.__setitem__ (d key val)
(let ((key.sym (py-string-val->symbol key)))
@@ -3200,6 +3230,10 @@ invocation form.\"")
(:method ((x vector)) (declare (ignorable x)) (ltv-find-class 'py-list ))
(:method ((x list)) (cond ((null x)
(break "PY-CLASS-OF of NIL"))
+ #+ecl
+ ((eq (car x) :custom-hash-table)
+ ;; XXX ugly: cl-custom-hash-table impl detail
+ (ltv-find-class 'dict))
((and (listp (car x)) (symbolp (caar x)))
(ltv-find-class 'py-alist))
(t
View
6 runtime/habitat.lisp
@@ -97,14 +97,16 @@
(check-type habitat habitat)
(remove-loaded-module module habitat)
(push module (habitat-loaded-mods habitat))
- (setf (gethash (module-name module) (get-sys.modules)) module))
+ (with-py-dict
+ (setf (gethash (module-name module) (get-sys.modules)) module)))
(defun remove-loaded-module (module habitat)
(setf (habitat-loaded-mods habitat)
(remove (module-bin-pathname module) (habitat-loaded-mods habitat)
:key #'module-bin-pathname
:test #'pathname-considered-equal))
- (remhash (module-name module) (get-sys.modules)))
+ (with-py-dict
+ (remhash (module-name module) (get-sys.modules))))
(defun pathname-considered-equal (x y)
(check-type x pathname)
View
7 runtime/import.lisp
@@ -324,7 +324,7 @@ Otherwise raises ImportError."
;; XXX this should not happen for e.g. module "dist", as that is in either "distutils.dist" or "setuptools.dist".
;; Need to figure out the exact rule; use this dot check for now.
(unless force-reload
- (whereas ((mod (gethash dotted-name (find-symbol-value '#:|modules| :clpython.module.sys))))
+ (whereas ((mod (with-py-dict (gethash dotted-name (find-symbol-value '#:|modules| :clpython.module.sys)))))
(return-from py-import (values mod :sys.modules))))
;; In case of a dotted import ("import a.b.c"), recursively import the parent "a.b"
@@ -501,5 +501,6 @@ Otherwise raises ImportError."
(check-type clpython::*all-modules* hash-table)
(clrhash clpython::*all-modules*))
(whereas ((ht (symbol-value (find-symbol (symbol-name '#:|modules|) :clpython.module.sys))))
- (check-type ht hash-table)
- (clrhash ht)))
+ (check-type ht (or hash-table #+ecl cl-custom-hash-table::custom-hash-table))
+ (with-py-dict
+ (clrhash ht))))
View
4 runtime/metaclass.lisp
@@ -120,6 +120,10 @@
(defun make-py-hash-table ()
(make-hash-table :test 'py-==->lisp-val))))
+(defmacro with-py-dict (&body body)
+ #+ecl `(cl-custom-hash-table:with-custom-hash-table ,@body)
+ #-ecl `(progn ,@body))
+
;; None and NotImplemented are here, so that other modules like classes can use the compiler macros.
(defclass py-none (object) () (:metaclass py-type))

0 comments on commit 62d4bcc

Please sign in to comment.
Something went wrong with that request. Please try again.