X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fvector.lisp;h=cc5ef22cfe3f0e8c096c8d97977e0b295f43a609;hb=906ecd4ef2d10aca23e1081f03c13fe2f932ed89;hp=c2590ec7eddb8e64a799b346e19db8694eb9cd1a;hpb=71922347ca66f2a3ad4c55092ccb3ad86a14c754;p=sbcl.git diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index c2590ec..cc5ef22 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -306,54 +306,6 @@ (setf (pvref pv i) (cdr map)))))) (incf param)))))) -(defun maybe-expand-accessor-form (form required-parameters slots env) - (let* ((fname (car form)) - #||(len (length form))||# - (gf (if (symbolp fname) - (unencapsulated-fdefinition fname) - (gdefinition fname)))) - (macrolet ((maybe-optimize-reader () - `(let ((parameter - (can-optimize-access1 (cadr form) - required-parameters env))) - (when parameter - (optimize-reader slots parameter gf-name form)))) - (maybe-optimize-writer () - `(let ((parameter - (can-optimize-access1 (caddr form) - required-parameters env))) - (when parameter - (optimize-writer slots parameter gf-name form))))) - (unless (and (consp (cadr form)) - (eq 'instance-accessor-parameter (caadr form))) - (when (and (eq *boot-state* 'complete) - (generic-function-p gf)) - (let ((methods (generic-function-methods gf))) - (when methods - (let* ((gf-name (generic-function-name gf)) - (arg-info (gf-arg-info gf)) - (metatypes (arg-info-metatypes arg-info)) - (nreq (length metatypes)) - (applyp (arg-info-applyp arg-info))) - (when (null applyp) - (cond ((= nreq 1) - (when (some #'standard-reader-method-p methods) - (maybe-optimize-reader))) - ((and (= nreq 2) - (consp gf-name) - (eq (car gf-name) 'setf)) - (when (some #'standard-writer-method-p methods) - (maybe-optimize-writer))))))))))))) - -(defun optimize-generic-function-call (form - required-parameters - env - slots - calls) - (declare (ignore required-parameters env slots calls)) - (or ; (optimize-reader ...)? - form)) - (defun can-optimize-access (form required-parameters env) (let ((type (ecase (car form) (slot-value 'reader) @@ -401,66 +353,115 @@ (optimize-slot-value-by-class-p class slot-name type)) (cons parameter-or-nil (or class class-name))))))))) +;;; Check whether the binding of the named variable is modified in the +;;; method body. +(defun parameter-modified-p (parameter-name env) + (let ((modified-variables (macroexpand '%parameter-binding-modified env))) + (memq parameter-name modified-variables))) + (defun optimize-slot-value (slots sparameter form) (if sparameter - (destructuring-bind (ignore1 ignore2 slot-name-form) form - (declare (ignore ignore1 ignore2)) - (let ((slot-name (eval slot-name-form))) - (optimize-instance-access slots :read sparameter slot-name nil))) + (let ((optimized-form + (destructuring-bind (ignore1 ignore2 slot-name-form) form + (declare (ignore ignore1 ignore2)) + (let ((slot-name (eval slot-name-form))) + (optimize-instance-access slots :read sparameter + slot-name nil))))) + ;; We don't return the optimized form directly, since there's + ;; still a chance that we'll find out later on that the + ;; optimization should not have been done, for example due to + ;; the walker encountering a SETQ on SPARAMETER later on in + ;; the body [ see for example clos.impure.lisp test with :name + ;; ((:setq :method-parameter) slot-value)) ]. Instead we defer + ;; the decision until the compiler macroexpands + ;; OPTIMIZED-SLOT-VALUE. + ;; + ;; Note that we must still call OPTIMIZE-INSTANCE-ACCESS at + ;; this point (instead of when expanding + ;; OPTIMIZED-SLOT-VALUE), since it mutates the structure of + ;; SLOTS. If that mutation isn't done during the walking, + ;; MAKE-METHOD-LAMBDA-INTERNAL won't wrap a correct PV-BINDING + ;; form around the body, and compilation will fail. -- JES, + ;; 2006-09-18 + `(optimized-slot-value ,form ,(car sparameter) ,optimized-form)) `(accessor-slot-value ,@(cdr form)))) +(defmacro optimized-slot-value (form parameter-name optimized-form + &environment env) + ;; Either use OPTIMIZED-FORM or fall back to the safe + ;; ACCESSOR-SLOT-VALUE. + (if (parameter-modified-p parameter-name env) + `(accessor-slot-value ,@(cdr form)) + optimized-form)) + (defun optimize-set-slot-value (slots sparameter form) (if sparameter - (destructuring-bind (ignore1 ignore2 slot-name-form new-value) form - (declare (ignore ignore1 ignore2)) - (let ((slot-name (eval slot-name-form))) - (optimize-instance-access slots - :write - sparameter - slot-name - new-value))) + (let ((optimized-form + (destructuring-bind (ignore1 ignore2 slot-name-form new-value) form + (declare (ignore ignore1 ignore2)) + (let ((slot-name (eval slot-name-form))) + (optimize-instance-access slots + :write + sparameter + slot-name + new-value))))) + ;; See OPTIMIZE-SLOT-VALUE + `(optimized-set-slot-value ,form ,(car sparameter) ,optimized-form)) `(accessor-set-slot-value ,@(cdr form)))) +(defmacro optimized-set-slot-value (form parameter-name optimized-form + &environment env) + (cond ((safe-code-p env) + ;; Don't optimize slot value setting in safe code, since the + ;; optimized version will fail to catch some type errors + ;; (for example when a subclass declares a tighter type for + ;; the slot than a superclass). + `(safe-set-slot-value ,@(cdr form))) + ((parameter-modified-p parameter-name env) + `(accessor-set-slot-value ,@(cdr form))) + (t + optimized-form))) + (defun optimize-slot-boundp (slots sparameter form) (if sparameter - (destructuring-bind - ;; FIXME: In CMU CL ca. 19991205, this binding list had a - ;; fourth element in it, NEW-VALUE. It's hard to see how - ;; that could possibly be right, since SLOT-BOUNDP has no - ;; NEW-VALUE. Since it was causing a failure in building PCL - ;; for SBCL, so I changed it to match the definition of - ;; SLOT-BOUNDP (and also to match the list used in the - ;; similar OPTIMIZE-SLOT-VALUE, above). However, I'm weirded - ;; out by this, since this is old code which has worked for - ;; ages to build PCL for CMU CL, so it's hard to see why it - ;; should need a patch like this in order to build PCL for - ;; SBCL. I'd like to return to this and find a test case - ;; which exercises this function both in CMU CL, to see - ;; whether it's really a previously-unexercised bug or - ;; whether I've misunderstood something (and, presumably, - ;; patched it wrong). - (slot-boundp-symbol instance slot-name-form) - form - (declare (ignore slot-boundp-symbol instance)) - (let ((slot-name (eval slot-name-form))) - (optimize-instance-access slots - :boundp - sparameter - slot-name - nil))) + (let ((optimized-form + (destructuring-bind + ;; FIXME: In CMU CL ca. 19991205, this binding list + ;; had a fourth element in it, NEW-VALUE. It's hard + ;; to see how that could possibly be right, since + ;; SLOT-BOUNDP has no NEW-VALUE. Since it was + ;; causing a failure in building PCL for SBCL, so I + ;; changed it to match the definition of + ;; SLOT-BOUNDP (and also to match the list used in + ;; the similar OPTIMIZE-SLOT-VALUE, + ;; above). However, I'm weirded out by this, since + ;; this is old code which has worked for ages to + ;; build PCL for CMU CL, so it's hard to see why it + ;; should need a patch like this in order to build + ;; PCL for SBCL. I'd like to return to this and + ;; find a test case which exercises this function + ;; both in CMU CL, to see whether it's really a + ;; previously-unexercised bug or whether I've + ;; misunderstood something (and, presumably, + ;; patched it wrong). + (slot-boundp-symbol instance slot-name-form) + form + (declare (ignore slot-boundp-symbol instance)) + (let ((slot-name (eval slot-name-form))) + (optimize-instance-access slots + :boundp + sparameter + slot-name + nil))))) + ;; See OPTIMIZE-SLOT-VALUE + `(optimized-slot-boundp ,form ,(car sparameter) ,optimized-form)) `(accessor-slot-boundp ,@(cdr form)))) -(defun optimize-reader (slots sparameter gf-name form) - (if sparameter - (optimize-accessor-call slots :read sparameter gf-name nil) - form)) - -(defun optimize-writer (slots sparameter gf-name form) - (if sparameter - (destructuring-bind (ignore1 ignore2 new-value) form - (declare (ignore ignore1 ignore2)) - (optimize-accessor-call slots :write sparameter gf-name new-value)) - form)) +(defmacro optimized-slot-boundp (form parameter-name optimized-form + &environment env) + (if (parameter-modified-p parameter-name env) + `(accessor-slot-boundp ,@(cdr form)) + optimized-form)) ;;; The SLOTS argument is an alist, the CAR of each entry is the name ;;; of a required parameter to the function. The alist is in order, so @@ -508,84 +509,6 @@ `(instance-boundp ,pv-offset-form ,parameter ,position ',slot-name ',class))))))) -(defun optimize-accessor-call (slots read/write sparameter gf-name new-value) - (let* ((class (if (consp sparameter) (cdr sparameter) *the-class-t*)) - (parameter (if (consp sparameter) (car sparameter) sparameter)) - (parameter-entry (assq parameter slots)) - (name (case read/write - (:read `(reader ,gf-name)) - (:write `(writer ,gf-name)))) - (slot-entry (assoc name (cdr parameter-entry) :test #'equal)) - (position (posq parameter-entry slots)) - (pv-offset-form (list 'pv-offset ''.PV-OFFSET.))) - (unless parameter-entry - (error "slot optimization bewilderment: O-A-C")) - (unless slot-entry - (setq slot-entry (list name)) - (push slot-entry (cdr parameter-entry))) - (push pv-offset-form (cdr slot-entry)) - (ecase read/write - (:read - `(instance-reader ,pv-offset-form ,parameter ,position ,gf-name ',class)) - (:write - `(let ((.new-value. ,new-value)) - (instance-writer ,pv-offset-form ,parameter ,position ,gf-name ',class - .new-value.)))))) - -(defvar *unspecific-arg* '..unspecific-arg..) - -(defun optimize-gf-call-internal (form slots env) - (when (and (consp form) - (eq (car form) 'the)) - (setq form (caddr form))) - (or (and (symbolp form) - (let* ((rebound? (caddr (var-declaration '%variable-rebinding - form - env))) - (parameter-or-nil (car (assq (or rebound? form) slots)))) - (when parameter-or-nil - (let* ((class-name (caddr (var-declaration 'class - parameter-or-nil - env)))) - (when (and class-name (not (eq class-name t))) - (position parameter-or-nil slots :key #'car)))))) - (if (constantp form) - (let ((form (constant-form-value form))) - (if (symbolp form) - form - *unspecific-arg*)) - *unspecific-arg*))) - -(defun optimize-gf-call (slots calls gf-call-form nreq restp env) - (unless (eq (car gf-call-form) 'make-instance) ; XXX needs more work - (let* ((args (cdr gf-call-form)) - (all-args-p (eq (car gf-call-form) 'make-instance)) - (non-required-args (nthcdr nreq args)) - (required-args (ldiff args non-required-args)) - (call-spec (list (car gf-call-form) nreq restp - (mapcar (lambda (form) - (optimize-gf-call-internal form slots env)) - (if all-args-p - args - required-args)))) - (call-entry (assoc call-spec calls :test #'equal)) - (pv-offset-form (list 'pv-offset ''.PV-OFFSET.))) - (unless (some #'integerp - (let ((spec-args (cdr call-spec))) - (if all-args-p - (ldiff spec-args (nthcdr nreq spec-args)) - spec-args))) - (return-from optimize-gf-call nil)) - (unless call-entry - (setq call-entry (list call-spec)) - (push call-entry (cdr calls))) - (push pv-offset-form (cdr call-entry)) - (if (eq (car call-spec) 'make-instance) - `(funcall (pv-ref .pv. ,pv-offset-form) ,@(cdr gf-call-form)) - `(let ((.emf. (pv-ref .pv. ,pv-offset-form))) - (invoke-effective-method-function .emf. ,restp - ,@required-args ,@(when restp `((list ,@non-required-args))))))))) - (define-walker-template pv-offset) ; These forms get munged by mutate slots. (defmacro pv-offset (arg) arg) (define-walker-template instance-accessor-parameter) @@ -621,10 +544,10 @@ (eq *boot-state* 'complete) (not (slot-accessor-std-p slotd type))))) -(defmacro instance-read-internal (pv slots pv-offset default &optional type) - (unless (member type '(nil :instance :class :default)) - (error "illegal type argument to ~S: ~S" 'instance-read-internal type)) - (if (eq type :default) +(defmacro instance-read-internal (pv slots pv-offset default &optional kind) + (unless (member kind '(nil :instance :class :default)) + (error "illegal kind argument to ~S: ~S" 'instance-read-internal kind)) + (if (eq kind :default) default (let* ((index (gensym)) (value index)) @@ -642,11 +565,11 @@ ;; to shut it up. (see also mail Rudi ;; Schlatte sbcl-devel 2003-09-21) -- CSR, ;; 2003-11-30 - ,@(when (or (null type) (eq type :instance)) + ,@(when (or (null kind) (eq kind :instance)) `((fixnum (and ,slots ; KLUDGE (clos-slots-ref ,slots ,index))))) - ,@(when (or (null type) (eq type :class)) + ,@(when (or (null kind) (eq kind :class)) `((cons (cdr ,index)))) (t +slot-unbound+))) (if (eq ,value +slot-unbound+) @@ -661,28 +584,21 @@ ,(if (generate-fast-class-slot-access-p class slot-name) :class :instance)))) -(defmacro instance-reader (pv-offset parameter position gf-name class) - (declare (ignore class)) - `(instance-read-internal .pv. ,(slot-vector-symbol position) - ,pv-offset - (,gf-name (instance-accessor-parameter ,parameter)) - :instance)) - (defmacro instance-write-internal (pv slots pv-offset new-value default - &optional type) - (unless (member type '(nil :instance :class :default)) - (error "illegal type argument to ~S: ~S" 'instance-write-internal type)) - (if (eq type :default) + &optional kind) + (unless (member kind '(nil :instance :class :default)) + (error "illegal kind argument to ~S: ~S" 'instance-write-internal kind)) + (if (eq kind :default) default (let* ((index (gensym))) `(locally (declare #.*optimize-speed*) (let ((,index (pvref ,pv ,pv-offset))) (typecase ,index - ,@(when (or (null type) (eq type :instance)) + ,@(when (or (null kind) (eq kind :instance)) `((fixnum (and ,slots (setf (clos-slots-ref ,slots ,index) ,new-value))))) - ,@(when (or (null type) (eq type :class)) + ,@(when (or (null kind) (eq kind :class)) `((cons (setf (cdr ,index) ,new-value)))) (t ,default))))))) @@ -700,37 +616,21 @@ ,(if (generate-fast-class-slot-access-p class slot-name) :class :instance)))) -(defmacro instance-writer (pv-offset - parameter - position - gf-name - class - new-value) - (declare (ignore class)) - `(instance-write-internal .pv. ,(slot-vector-symbol position) - ,pv-offset ,new-value - (,(if (consp gf-name) - (get-setf-fun-name gf-name) - gf-name) - (instance-accessor-parameter ,parameter) - ,new-value) - :instance)) - (defmacro instance-boundp-internal (pv slots pv-offset default - &optional type) - (unless (member type '(nil :instance :class :default)) - (error "illegal type argument to ~S: ~S" 'instance-boundp-internal type)) - (if (eq type :default) + &optional kind) + (unless (member kind '(nil :instance :class :default)) + (error "illegal kind argument to ~S: ~S" 'instance-boundp-internal kind)) + (if (eq kind :default) default (let* ((index (gensym))) `(locally (declare #.*optimize-speed*) (let ((,index (pvref ,pv ,pv-offset))) (typecase ,index - ,@(when (or (null type) (eq type :instance)) + ,@(when (or (null kind) (eq kind :instance)) `((fixnum (not (and ,slots (eq (clos-slots-ref ,slots ,index) +slot-unbound+)))))) - ,@(when (or (null type) (eq type :class)) + ,@(when (or (null kind) (eq kind :class)) `((cons (not (eq (cdr ,index) +slot-unbound+))))) (t ,default))))))) @@ -911,6 +811,7 @@ %method-lambda-list optimize ftype + muffle-conditions inline notinline)) @@ -1051,57 +952,115 @@ (incf nreq) (push arg args)) (setq args (nreverse args)) - (setf (getf (getf initargs :plist) :arg-info) (cons nreq restp)) + (setf (getf (getf initargs 'plist) :arg-info) (cons nreq restp)) (make-method-initargs-form-internal1 initargs (cddr lmf) args lmf-params restp))))) +(defun lambda-list-parameter-names (lambda-list) + ;; Given a valid lambda list, extract the parameter names. + (loop for x in lambda-list + with res = nil + do (unless (member x lambda-list-keywords) + (if (consp x) + (let ((name (car x))) + (if (consp name) + ;; ... ((:BAR FOO) 1) + (push (second name) res) + ;; ... (FOO 1) + (push name res)) + ;; ... (... 1 FOO-P) + (let ((name-p (cddr x))) + (when name-p + (push (car name-p) res)))) + ;; ... FOO + (push x res))) + finally (return res))) + (defun make-method-initargs-form-internal1 (initargs body req-args lmf-params restp) - (multiple-value-bind (outer-decls inner-decls body-sans-decls) - (split-declarations - body req-args (or (getf (cdr lmf-params) :call-next-method-p) - (getf (cdr lmf-params) :setq-p))) - (let* ((rest-arg (when restp '.rest-arg.)) - (args+rest-arg (if restp - (append req-args (list rest-arg)) - req-args))) - `(list* - :fast-function - (,(if (body-method-name body) 'named-lambda 'lambda) - ,@(when (body-method-name body) - ;; function name - (list (cons 'fast-method (body-method-name body)))) - (.pv-cell. .next-method-call. ,@args+rest-arg) ; function args - ;; body of the function - (declare (ignorable .pv-cell. .next-method-call.) - (disable-package-locks pv-env-environment)) - ,@outer-decls - (symbol-macrolet ((pv-env-environment default)) - (fast-lexical-method-functions - (,(car lmf-params) .next-method-call. ,req-args ,rest-arg - ,@(cdddr lmf-params)) - ,@inner-decls - ,@body-sans-decls))) - ',initargs)))) + (let* (;; The lambda-list of the method, minus specifiers + (lambda-list (car lmf-params)) + ;; Names of the parameters that will be in the outermost lambda-list + ;; (and whose bound declarations thus need to be in OUTER-DECLS). + (outer-parameters req-args) + ;; The lambda-list used by BIND-ARGS + (bind-list lambda-list) + (setq-p (getf (cdr lmf-params) :setq-p)) + (auxp (member '&aux bind-list)) + (call-next-method-p (getf (cdr lmf-params) :call-next-method-p))) + ;; Try to use the normal function call machinery instead of BIND-ARGS + ;; binding the arguments, unless: + (unless (or ;; If all arguments are required, BIND-ARGS will be a no-op + ;; in any case. + (and (not restp) (not auxp)) + ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a + ;; list of all non-required arguments. + call-next-method-p) + (setf ;; We don't want a binding for .REST-ARG. + restp nil + ;; Get all the parameters for declaration parsing + outer-parameters (lambda-list-parameter-names lambda-list) + ;; Ensure that BIND-ARGS won't do anything (since + ;; BIND-LIST won't contain any non-required parameters, + ;; and REQ-ARGS will be of an equal length). We still want + ;; to pass BIND-LIST to FAST-LEXICAL-METHOD-FUNCTIONS so + ;; that BIND-FAST-LEXICAL-METHOD-FUNCTIONS can take care + ;; of rebinding SETQd required arguments around the method + ;; body. + bind-list req-args)) + (multiple-value-bind (outer-decls inner-decls body-sans-decls) + (split-declarations + body outer-parameters (or call-next-method-p setq-p)) + (let* ((rest-arg (when restp + '.rest-arg.)) + (fmf-lambda-list (if rest-arg + (append req-args (list '&rest rest-arg)) + (if call-next-method-p + req-args + lambda-list)))) + `(list* + :function + (let* ((fmf (,(if (body-method-name body) 'named-lambda 'lambda) + ,@(when (body-method-name body) + ;; function name + (list (cons 'fast-method (body-method-name body)))) + ;; The lambda-list of the FMF + (.pv-cell. .next-method-call. ,@fmf-lambda-list) + ;; body of the function + (declare (ignorable .pv-cell. .next-method-call.) + (disable-package-locks pv-env-environment)) + ,@outer-decls + (symbol-macrolet ((pv-env-environment default)) + (fast-lexical-method-functions + (,bind-list .next-method-call. ,req-args ,rest-arg + ,@(cdddr lmf-params)) + ,@inner-decls + ,@body-sans-decls)))) + (mf (%make-method-function fmf nil))) + (set-funcallable-instance-function + mf (method-function-from-fast-function fmf ',(getf initargs 'plist))) + mf) + ',initargs))))) ;;; Use arrays and hash tables and the fngen stuff to make this much ;;; better. It doesn't really matter, though, because a function ;;; returned by this will get called only when the user explicitly ;;; funcalls a result of method-function. BUT, this is needed to make ;;; early methods work. -(defun method-function-from-fast-function (fmf) +(defun method-function-from-fast-function (fmf plist) (declare (type function fmf)) - (let* ((method-function nil) (pv-table nil) - (arg-info (method-function-get fmf :arg-info)) + (let* ((method-function nil) + (calls (getf plist :call-list)) + (snl (getf plist :slot-name-lists)) + (pv-table (when (or calls snl) + (intern-pv-table :call-list calls :slot-name-lists snl))) + (arg-info (getf plist :arg-info)) (nreq (car arg-info)) (restp (cdr arg-info))) (setq method-function (lambda (method-args next-methods) - (unless pv-table - (setq pv-table (method-function-pv-table fmf))) (let* ((pv-cell (when pv-table - (get-method-function-pv-cell - method-function method-args pv-table))) + (get-pv-cell method-args pv-table))) (nm (car next-methods)) (nms (cdr next-methods)) (nmc (when nm @@ -1110,25 +1069,38 @@ (method-function nm) nm) :call-method-args (list nms))))) - (if restp - (let* ((rest (nthcdr nreq method-args)) - (args (ldiff method-args rest))) - (apply fmf pv-cell nmc (nconc args (list rest)))) - (apply fmf pv-cell nmc method-args))))) - (let* ((fname (method-function-get fmf :name)) - (name (cons 'slow-method (cdr fname)))) - (set-fun-name method-function name)) - (setf (method-function-get method-function :fast-function) fmf) + (apply fmf pv-cell nmc method-args)))) + ;; FIXME: this looks dangerous. + (let* ((fname (%fun-name fmf))) + (when (and fname (eq (car fname) 'fast-method)) + (set-fun-name method-function (cons 'slow-method (cdr fname))))) method-function)) -(defun get-method-function-pv-cell (method-function - method-args - &optional pv-table) - (let ((pv-table (or pv-table (method-function-pv-table method-function)))) - (when pv-table - (let ((pv-wrappers (pv-wrappers-from-all-args pv-table method-args))) - (when pv-wrappers - (pv-table-lookup pv-table pv-wrappers)))))) +;;; this is similar to the above, only not quite. Only called when +;;; the MOP is heavily involved. Not quite parallel to +;;; METHOD-FUNCTION-FROM-FAST-METHOD-FUNCTION, because we can close +;;; over the actual PV-CELL in this case. +(defun method-function-from-fast-method-call (fmc) + (let* ((fmf (fast-method-call-function fmc)) + (pv-cell (fast-method-call-pv-cell fmc)) + (arg-info (fast-method-call-arg-info fmc)) + (nreq (car arg-info)) + (restp (cdr arg-info))) + (lambda (method-args next-methods) + (let* ((nm (car next-methods)) + (nms (cdr next-methods)) + (nmc (when nm + (make-method-call + :function (if (std-instance-p nm) + (method-function nm) + nm) + :call-method-args (list nms))))) + (apply fmf pv-cell nmc method-args))))) + +(defun get-pv-cell (method-args pv-table) + (let ((pv-wrappers (pv-wrappers-from-all-args pv-table method-args))) + (when pv-wrappers + (pv-table-lookup pv-table pv-wrappers)))) (defun pv-table-lookup-pv-args (pv-table &rest pv-parameters) (pv-table-lookup pv-table (pv-wrappers-from-pv-args pv-parameters))) @@ -1155,3 +1127,4 @@ when snl collect w into result finally (return (if (cdr result) result (car result))))) +