X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fmethods.lisp;fp=src%2Fmethods.lisp;h=0000000000000000000000000000000000000000;hb=e8b227cbde3cf3eeb9b28f347f9ff78acb0cf0a8;hp=4688d2bfb0dd0da86d705e97992400cff0290762;hpb=9635bd8a9ea703c1ea60feb8c16984692a6af6c0;p=cl-mock.git

diff --git a/src/methods.lisp b/src/methods.lisp
deleted file mode 100644
index 4688d2b..0000000
--- a/src/methods.lisp
+++ /dev/null
@@ -1,76 +0,0 @@
-;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*-
-
-(in-package #:cl-mock)
-
-;;; mocking of generic methods and objects
-
-(defun find-methods (methods)
-  (mapcar (lambda (method)
-            (destructuring-bind (generic-function qualifiers specializers) method
-              (cons
-               generic-function
-               (find-method generic-function qualifiers specializers NIL))))
-          methods))
-
-;; TODO: because we use ENSURE-METHOD, each value is a FORM rather than a
-;; FUNCTION, so not quite the same as PROGF; judging by the implementation-
-;; specific code in CLOSER-MOP, we also can just create method objects
-;; ourselves reliably, so either we duplicate the cases or just use SBCL
-
-(defun call-with-method-bindings* (methods values function
-                                   &optional (previous (find-methods methods)))
-  (mapc (lambda (previous)
-          (destructuring-bind (generic-function . method) previous
-            (when method
-              (remove-method generic-function method))))
-        previous)
-  (let ((new-methods
-          (mapcar (lambda (method previous value)
-                    (destructuring-bind (generic-function qualifiers specializers) method
-                      (declare (ignore generic-function))
-                      (destructuring-bind (generic-function . method) previous
-                        (cons
-                         generic-function
-                         (if method
-                             (ensure-method generic-function value
-                                            :method-class (class-of method)
-                                            :qualifiers (method-qualifiers method)
-                                            :lambda-list (method-lambda-list method)
-                                            :specializers (method-specializers method))
-                             (ensure-method generic-function value
-                                            :qualifiers qualifiers
-                                            :specializers specializers))))))
-                  methods previous values)))
-    (unwind-protect (funcall function)
-      (mapc (lambda (new-method)
-              (destructuring-bind (generic-function . method) new-method
-                (remove-method generic-function method)))
-            new-methods)
-      (mapc (lambda (previous)
-              (destructuring-bind (generic-function . method) previous
-                (when method
-                  (add-method generic-function method))))
-            previous))))
-
-(defmacro progm* (methods values &body body)
-  `(call-with-method-bindings* ,methods ,values (lambda () ,@body)))
-
-(defun classify (specializer)
-  (if (classp specializer)
-      specializer
-      (find-class specializer)))
-
-(defun call-with-method-bindings (methods values function
-                                  &optional previous)
-  (let ((methods
-          (mapcar (lambda (method)
-                    (destructuring-bind (generic-function qualifiers specializers) method
-                      (list
-                       (ensure-function generic-function)
-                       qualifiers
-                       (mapcar #'classify specializers))))
-                  methods)))
-    (call-with-method-bindings* methods values function (or previous (find-methods methods)))))
-
-(defmacro progm (methods values &body body)
-  `(call-with-method-bindings ,methods ,values (lambda () ,@body)))