Changeset 13776


Ignore:
Timestamp:
01/15/12 07:24:34 (9 years ago)
Author:
ehuelsmann
Message:

Remove ineffective LET binding which only returns its bound value immediately.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13775 r13776  
    18411841
    18421842(defun std-compute-discriminating-function (gf)
    1843   (let ((code
    1844          (cond
    1845            ((and (= (length (generic-function-methods gf)) 1)
    1846                  (typep (car (generic-function-methods gf)) 'standard-reader-method))
    1847             ;;                 (sys::%format t "standard reader function ~S~%" (generic-function-name gf))
    1848 
    1849             (let* ((method (%car (generic-function-methods gf)))
    1850                    (class (car (%method-specializers method)))
    1851                    (slot-name (reader-method-slot-name method)))
    1852               #'(lambda (arg)
     1843  (cond
     1844    ((and (= (length (generic-function-methods gf)) 1)
     1845          (typep (car (generic-function-methods gf)) 'standard-reader-method))
     1846     ;;                 (sys::%format t "standard reader function ~S~%" (generic-function-name gf))
     1847
     1848     (let* ((method (%car (generic-function-methods gf)))
     1849            (class (car (%method-specializers method)))
     1850            (slot-name (reader-method-slot-name method)))
     1851       #'(lambda (arg)
     1852           (declare (optimize speed))
     1853           (let* ((layout (std-instance-layout arg))
     1854                  (location (get-cached-slot-location gf layout)))
     1855             (unless location
     1856               (unless (simple-typep arg class)
     1857                 ;; FIXME no applicable method
     1858                 (error 'simple-type-error
     1859                        :datum arg
     1860                        :expected-type class))
     1861               (setf location (slow-reader-lookup gf layout slot-name)))
     1862             (if (consp location)
     1863                 ;; Shared slot.
     1864                 (cdr location)
     1865                 (standard-instance-access arg location))))))
     1866
     1867    (t
     1868     (let* ((emf-table (classes-to-emf-table gf))
     1869            (number-required (length (gf-required-args gf)))
     1870            (lambda-list (%generic-function-lambda-list gf))
     1871            (exact (null (intersection lambda-list
     1872                                       '(&rest &optional &key
     1873                                         &allow-other-keys &aux)))))
     1874       (if exact
     1875           (cond
     1876             ((= number-required 1)
     1877              (cond
     1878                ((and (eq (generic-function-method-combination gf) 'standard)
     1879                      (= (length (generic-function-methods gf)) 1))
     1880                 (let* ((method (%car (generic-function-methods gf)))
     1881                        (specializer (car (%method-specializers method)))
     1882                        (function (or (%method-fast-function method)
     1883                                      (%method-function method))))
     1884                   (if (typep specializer 'eql-specializer)
     1885                       (let ((specializer-object (eql-specializer-object specializer)))
     1886                         #'(lambda (arg)
     1887                             (declare (optimize speed))
     1888                             (if (eql arg specializer-object)
     1889                                 (funcall function arg)
     1890                                 (no-applicable-method gf (list arg)))))
     1891                       #'(lambda (arg)
     1892                           (declare (optimize speed))
     1893                           (unless (simple-typep arg specializer)
     1894                             ;; FIXME no applicable method
     1895                             (error 'simple-type-error
     1896                                    :datum arg
     1897                                    :expected-type specializer))
     1898                           (funcall function arg)))))
     1899                (t
     1900                 #'(lambda (arg)
     1901                     (declare (optimize speed))
     1902                     (let* ((specialization
     1903                             (%get-arg-specialization gf arg))
     1904                            (emfun (or (gethash1 specialization
     1905                                                 emf-table)
     1906                                       (slow-method-lookup-1
     1907                                        gf arg specialization))))
     1908                       (if emfun
     1909                           (funcall emfun (list arg))
     1910                           (apply #'no-applicable-method gf (list arg))))))))
     1911             ((= number-required 2)
     1912              #'(lambda (arg1 arg2)
    18531913                  (declare (optimize speed))
    1854                   (let* ((layout (std-instance-layout arg))
    1855                          (location (get-cached-slot-location gf layout)))
    1856                     (unless location
    1857                       (unless (simple-typep arg class)
    1858                         ;; FIXME no applicable method
    1859                         (error 'simple-type-error
    1860                                :datum arg
    1861                                :expected-type class))
    1862                       (setf location (slow-reader-lookup gf layout slot-name)))
    1863                     (if (consp location)
    1864                         ;; Shared slot.
    1865                         (cdr location)
    1866                         (standard-instance-access arg location))))))
    1867 
    1868            (t
    1869             (let* ((emf-table (classes-to-emf-table gf))
    1870                    (number-required (length (gf-required-args gf)))
    1871                    (lambda-list (%generic-function-lambda-list gf))
    1872                    (exact (null (intersection lambda-list
    1873                                               '(&rest &optional &key
    1874                                                 &allow-other-keys &aux)))))
    1875               (if exact
    1876                   (cond
    1877                     ((= number-required 1)
    1878                      (cond
    1879                        ((and (eq (generic-function-method-combination gf) 'standard)
    1880                              (= (length (generic-function-methods gf)) 1))
    1881                         (let* ((method (%car (generic-function-methods gf)))
    1882                                (specializer (car (%method-specializers method)))
    1883                                (function (or (%method-fast-function method)
    1884                                              (%method-function method))))
    1885                           (if (typep specializer 'eql-specializer)
    1886                               (let ((specializer-object (eql-specializer-object specializer)))
    1887                                 #'(lambda (arg)
    1888                                     (declare (optimize speed))
    1889                                     (if (eql arg specializer-object)
    1890                                         (funcall function arg)
    1891                                         (no-applicable-method gf (list arg)))))
    1892                               #'(lambda (arg)
    1893                                   (declare (optimize speed))
    1894                                   (unless (simple-typep arg specializer)
    1895                                     ;; FIXME no applicable method
    1896                                     (error 'simple-type-error
    1897                                            :datum arg
    1898                                            :expected-type specializer))
    1899                                   (funcall function arg)))))
    1900                        (t
    1901                         #'(lambda (arg)
    1902                             (declare (optimize speed))
    1903                             (let* ((specialization
    1904                                     (%get-arg-specialization gf arg))
    1905                                    (emfun (or (gethash1 specialization
    1906                                                         emf-table)
    1907                                               (slow-method-lookup-1
    1908                                                gf arg specialization))))
    1909                               (if emfun
    1910                                   (funcall emfun (list arg))
    1911                                   (apply #'no-applicable-method gf (list arg))))))))
    1912                     ((= number-required 2)
    1913                      #'(lambda (arg1 arg2)
    1914                          (declare (optimize speed))
    1915                          (let* ((args (list arg1 arg2))
    1916                                 (emfun (get-cached-emf gf args)))
    1917                            (if emfun
    1918                                (funcall emfun args)
    1919                                (slow-method-lookup gf args)))))
    1920                     ((= number-required 3)
    1921                      #'(lambda (arg1 arg2 arg3)
    1922                          (declare (optimize speed))
    1923                          (let* ((args (list arg1 arg2 arg3))
    1924                                 (emfun (get-cached-emf gf args)))
    1925                            (if emfun
    1926                                (funcall emfun args)
    1927                                (slow-method-lookup gf args)))))
    1928                     (t
    1929                      #'(lambda (&rest args)
    1930                          (declare (optimize speed))
    1931                          (let ((len (length args)))
    1932                            (unless (= len number-required)
    1933                              (error 'program-error
    1934                                     :format-control "Not enough arguments for generic function ~S."
    1935                                     :format-arguments (list (%generic-function-name gf)))))
    1936                          (let ((emfun (get-cached-emf gf args)))
    1937                            (if emfun
    1938                                (funcall emfun args)
    1939                                (slow-method-lookup gf args))))))
    1940                   #'(lambda (&rest args)
    1941                       (declare (optimize speed))
    1942                       (let ((len (length args)))
    1943                         (unless (>= len number-required)
    1944                           (error 'program-error
    1945                                  :format-control "Not enough arguments for generic function ~S."
    1946                                  :format-arguments (list (%generic-function-name gf)))))
    1947                       (let ((emfun (get-cached-emf gf args)))
    1948                         (if emfun
    1949                             (funcall emfun args)
    1950                             (slow-method-lookup gf args))))))))))
    1951 
    1952     code))
     1914                  (let* ((args (list arg1 arg2))
     1915                         (emfun (get-cached-emf gf args)))
     1916                    (if emfun
     1917                        (funcall emfun args)
     1918                        (slow-method-lookup gf args)))))
     1919             ((= number-required 3)
     1920              #'(lambda (arg1 arg2 arg3)
     1921                  (declare (optimize speed))
     1922                  (let* ((args (list arg1 arg2 arg3))
     1923                         (emfun (get-cached-emf gf args)))
     1924                    (if emfun
     1925                        (funcall emfun args)
     1926                        (slow-method-lookup gf args)))))
     1927             (t
     1928              #'(lambda (&rest args)
     1929                  (declare (optimize speed))
     1930                  (let ((len (length args)))
     1931                    (unless (= len number-required)
     1932                      (error 'program-error
     1933                             :format-control "Not enough arguments for generic function ~S."
     1934                             :format-arguments (list (%generic-function-name gf)))))
     1935                  (let ((emfun (get-cached-emf gf args)))
     1936                    (if emfun
     1937                        (funcall emfun args)
     1938                        (slow-method-lookup gf args))))))
     1939           #'(lambda (&rest args)
     1940               (declare (optimize speed))
     1941               (let ((len (length args)))
     1942                 (unless (>= len number-required)
     1943                   (error 'program-error
     1944                          :format-control "Not enough arguments for generic function ~S."
     1945                          :format-arguments (list (%generic-function-name gf)))))
     1946               (let ((emfun (get-cached-emf gf args)))
     1947                 (if emfun
     1948                     (funcall emfun args)
     1949                     (slow-method-lookup gf args)))))))))
    19531950
    19541951(defun sort-methods (methods gf required-classes)
Note: See TracChangeset for help on using the changeset viewer.