Overhaul and version bump.

[cl-mock.git] / src / facade.lisp

diff --git a/src/facade.lisp b/src/facade.lisp
index e14c4ea..a16e88f 100644 (file)
--- a/src/facade.lisp
+++ b/src/facade.lisp
@@ -4,52 +4,28 @@
 \f
 ;;; syntactic sugar for defining the mock interactions
 
-(defun make-lambda-pattern (literal-pattern)
-  (let (lambda-pattern values)
-    (loop
-      for (car . cdr) = literal-pattern
-      while car
-      do (let ((sym (gensym)))
-           (setf lambda-pattern (append lambda-pattern (list sym)))
-           (push `(,sym . ,(if (or (symbolp car) (listp car)) `(quote ,car) car)) values)
-           (pop literal-pattern)))
-    (values lambda-pattern values)))
+(defun true (&rest arguments)
+  (declare (ignore arguments))
+  T)
 
-(defun make-test-pattern (values)
-  `(and ,.(mapcar (lambda (value)
-                    `(equal ,(car value) ,(cdr value)))
-                  values)))
-
-(defmacro when-called (mock-bindings call &body forms)
+(defmacro answer (call &body forms)
   (let ((name (if (listp call) (car call) call))
         (sym (gensym)))
     `(if-called
-      ,mock-bindings
       ',name
-      ,(if (listp call)
-           (multiple-value-bind (lambda-pattern values)
-               (make-lambda-pattern (cdr call))
-             `(lambda (&rest args)
-                (destructuring-bind ,lambda-pattern args
-                  ,(make-test-pattern values))))
-           '(constantly T))
       (let ((,sym (fdefinition ',name)))
         (declare (ignorable ,sym))
-        ,(if (cdr forms)
-             `(let ((times 0))
-                (lambda (&rest args)
-                  (declare (ignorable args))
-                  (case (prog1 times (incf times))
-                    ,.(loop
-                        for i from 0
-                        for (form . rest) on forms
-                        collect `(,(if rest i T) ,form)))))
-             `(lambda (&rest args)
-                (declare (ignorable args))
-                ,@forms))))))
-
-(defun invocation-count (name invocations)
-  (count name invocations :key #'car :test #'eq))
-
-(defun was-called-p (name invocations)
-  (member name invocations :key #'car :test #'eq))
+        (let ((times 0))
+          (lambda (&rest args)
+            (declare (ignorable args))
+            ,(let ((cases
+                     `(case (prog1 times (incf times))
+                        ,.(loop
+                            for i from 0
+                            for (form . rest) on forms
+                            collect `(,(if rest i T) ,form)))))
+               (if (listp call)
+                   `(match args
+                     ((list . ,(cdr call)) ,cases)
+                     (_ (unhandled)))
+                   cases))))))))