sellout / quid-pro-quo Goto Github PK

View Code? Open in Web Editor NEW

92.0 8.0 9.0 433 KB

A contract programming library for Common Lisp in the style of Eiffel’s Design by Contract ™.

License: Other

Common Lisp 100.00%

common-lisp eiffel postcondition preconditions design-by-contract

quid-pro-quo's Introduction

Quid Pro Quo

A contract programming library for Common Lisp in the style of Eiffel’s Design by Contract ™.

What is it all about?

One main goals of every program is reliability, that is, correctness and robustness. A program is correct if it performs according to its specification, it is robust if it handles situations that were not covered in the specification in a graceful manner. One way to prove the correctness of a program with respect to a (formal) specification is the Hoare calculus. Based on this formal method Bertrand Meyer developed a method of software engineering called Design by Contract ™.

The principal idea of contract programming is that a class and its clients have a contract with each other: The client must guarantee certain conditions before calling a method specialized on the class (the preconditions), the class guarantees certain properties after the call (the postconditions). If the pre- and postconditions are included in a form that the compiler can check, then any violation of the contract between caller and class can be detected immediately.

Support for Contract Programming in Programming Languages

The language that offers the best support for contract programming is Eiffel, designed by Bertrand Meyer. It is rather difficult to add support for contract programming to most other languages, but not so for Common Lisp: I [Matthias Hölzl] have written a package for Common Lisp that provides support for contract programming. It is still very new and not too well tested so you should expect some rough edges and changes in its future design. There is no larger program depending on this package available, only some silly test cases. Since I intend to use the Quid Pro Quo package for my own programs this should change in the not so distant future.

Contract Programming in Common Lisp.

One of the outstanding features of the Eiffel language is that it supports a concept called contract programming. A comprehensive description is given in the following books

Object Oriented Software Construction, 2nd ed. Bertrand Meyer Prentice Hall PTR, 1997 ISBN 0-13-629155-4

Eiffel: The Language, 2nd ed. Bertrand Meyer Prentice Hall PTR, 1992 ISBN ???

but the key point of contract programming is that the relationship between a class and its clients is specified by a contract: There are certain conditions that the caller of a method specialized on a class has to fulfill so that the method can do its job (the preconditions) and the method guarantees certain things after its completion (the postconditions). Furthermore a class may have certain properties that are always true about that class; these properties are called invariants.

This file contains an implementation of contract programming for CLOS. Pre- and postconditions as well as invariants are specified by qualified methods of type contract; the usual before, after and around method combinations are available for these methods as well.

Implementation Support

ABCL – YES as of 1.1.1
Allegro – YES (both ANSI & modern)
CLISP – YES but creation invariants are ignored (33 pass, 4 fail)
Clozure – YES
CMUCL – YES
Corman – NO, it’s not supported by Closer-MOP
ECL – NO, DEFINE-METHOD-COMBINATION is broken
LispWorks – currently fails tests (10 pass, 25 fail)
SBCL – YES
Scineer – ? (would be happy to find someone to test it)

Usage

Preconditions (defrequirement) and postconditions (defguarantee) are added to functions. This works for both generic and non-generic functions (but contracts on non-generic functions may do nothing on certain lisp implementations).

(defrequirement put (item (stack stack))
  "the stack is not full"
  (declare (ignore item))
  (not (full stack)))

(defguarantee put (item (stack stack))
  (and (not (empty stack))
       (eq (top-item stack) item)
       (= (count stack) (1+ (old (count stack))))))

(defguarantee pop-stack ((stack stack))
  (and (not (full stack))
       (eq (results) (old (top-item stack)))
       (= (count stack) (1- (old (count stack)))))

This simple example illustrates a few things:

the docstring is included in any contract failure messages,
the macro old is available in postconditions so that state from before the call can be compared to the state after the call, and
the function results is available in postconditions which returns the same values returned by the primary method.

These contracts can also be created similarly to :before and :after methods, primarily for defgeneric convenience. In this case, the optional description of what is being required or guaranteed can be included between the method qualifier and the lambda list (this is because the docstring is not necessarily accessible).

(defgeneric put (item stack)
  (:method :require "the stack is not full" (item (stack stack))
    (declare (ignore item))
    (not (full stack)))
  (:method :guarantee (item (stack stack))
    (and (not (empty stack))
         (eq (top-item stack) item)
         (= (count stack) (1+ (old (count stack))))))

(defmethod pop-stack :guarantee ((stack stack))
  (and (not (full stack))
       (eq (results) (old (top-item stack)))
       (= (count stack) (1- (old (count stack)))))

Invariants can be placed on classes.

(defclass stack ()
  ((capacity :initarg :capacity :reader capacity :type integer)
   (count :initform 0 :reader count :type integer)
   (top-item :reader top-item))
  (:metaclass contracted-class)
  (:invariants (lambda (instance)
                 "the count must be between 0 and the capacity"
                 (<= 0 (count instance) (capacity instance)))
               (lambda (instance)
                 "there is no top-item if the stack is empty"
                 (implies (empty instance)
                          (not (slot-boundp instance 'top-item))))))

In order to have invariants on a class, the metaclass must be specified as contracted-class.

Invariants are added to classes explicitly with the :invariants option, which allows you to specify any number of predicates that take the instance as their only argument. When available (depending on the Lisp implementation), the documentation string for the function is used. If no documentation is available, we fall back to the body (in the case of a lambda) or the function name and its documentation as the description.

This also illustrates another macro that is useful in contracts – implies. With implies, the second argument is only tested if the first argument is true.

Types are also checked as invariants. Most implementations check slot types little enough that it's possible for a bad value to end up there in some cases.

The description is included in the report if a contract-violation-error is raised. The description is also added to the documentation for the class, function, or primary method as appropriate. Slot type declarations are also added to the class documentation.

quid-pro-quo's People

Contributors

Stargazers

Watchers

Forkers

harleqin budden csrhodes ktp-forked-repos cl-kuthirgal stalafuse dumaiu rosbo018 andrewchawk

quid-pro-quo's Issues

Metadata for Quicklisp

Please consider adding :description, :author and :license information to your ASDF system. This will greatly help Quicklisp users and make it easier for them to report bugs.

More information:

http://blog.quicklisp.org/2015/05/looking-for-more-metadata.html
https://www.quicklisp.org

style warnings on SBCL

Loading with SBCL 1.0.47, I get the following output.

; file: /Users/greg/Documents/Lisp-community/dbc/src/method-combination.lisp
; in: DEFINE-METHOD-COMBINATION CONTRACT
;     (OR QUID-PRO-QUO::WRITER-OBJECT QUID-PRO-QUO::READER-OBJECT)
; --> LET IF OR THE 
; ==>
;   QUID-PRO-QUO::READER-OBJECT
; 
; note: deleting unreachable code
; 
; note: deleting unreachable code

; /Users/greg/.cache/common-lisp/sbcl-1.0.47-macosx-x86/Users/greg/Documents/Lisp-community/dbc/src/ASDF-TMP-method-combination.fasl written
; compilation finished in 0:00:00.198
; compiling file "/Users/greg/Documents/Lisp-community/dbc/src/metaclass.lisp" (written 27 APR 2011 09:54:36 AM):
; compiling (IN-PACKAGE #:QUID-PRO-QUO)
; compiling (DEFCLASS CONTRACTED-CLASS ...)
; compiling (DEFMETHOD DOCUMENTATION ...)
; compiling (DEFMETHOD DOCUMENTATION ...)
; compiling (DEFMETHOD VALIDATE-SUPERCLASS ...)
; compiling (DEFGENERIC CLASS-INVARIANTS ...)
; compiling (DEFGENERIC CLASS-INVARIANT-DESCRIPTIONS ...)
; compiling (DEFUN PASSES-CLASS-INVARIANTS-P ...)
; compiling (DEFUN PASSES-SLOT-TYPE-INVARIANTS-P ...)
; compiling (DEFUN PASSES-INVARIANTS-P ...)
; compiling (DEFUN ADD-INVARIANT ...)
; compiling (DEFUN ADD-READER-INVARIANT ...)
; compiling (DEFUN ADD-WRITER-INVARIANT ...)
; compiling (DEFUN ALL-DIRECT-SLOTS ...)
; compiling (DEFUN ADD-ACCESSOR-INVARIANTS ...)
; compiling (DEFVAR *INVARIANT-INITIALIZERS* ...)
; compiling (DEFMETHOD INITIALIZE-INSTANCE ...)
; compiling (DEFMETHOD REINITIALIZE-INSTANCE ...)
; compiling (DEFGENERIC MAKE-INSTANCE ...)

; file: /Users/greg/Documents/Lisp-community/dbc/src/metaclass.lisp
; in: DEFGENERIC MAKE-INSTANCE
;     (CLOSER-MOP:DEFGENERIC MAKE-INSTANCE
;         (CLASS &REST QUID-PRO-QUO::INITARGS)
;       (:METHOD-COMBINATION QUID-PRO-QUO:CONTRACT)
;       (:METHOD :ENSURE
;        ((CLASS QUID-PRO-QUO:CONTRACTED-CLASS) &REST QUID-PRO-QUO::INITARGS)
;        (DECLARE (IGNORABLE QUID-PRO-QUO::INITARGS))
;        (QUID-PRO-QUO::PASSES-INVARIANTS-P (QUID-PRO-QUO:RESULTS))))
; --> PROGN 
; ==>
;   (EVAL-WHEN (:COMPILE-TOPLEVEL)
;     (DEFGENERIC MAKE-INSTANCE
;         (CLASS &REST QUID-PRO-QUO::INITARGS)
;       (:METHOD-COMBINATION QUID-PRO-QUO:CONTRACT)))
; 
; caught STYLE-WARNING:
;   redefining COMMON-LISP:MAKE-INSTANCE in DEFGENERIC

; /Users/greg/.cache/common-lisp/sbcl-1.0.47-macosx-x86/Users/greg/Documents/Lisp-community/dbc/src/ASDF-TMP-metaclass.fasl written
; compilation finished in 0:00:00.180
WARNING:
   COMPILE-FILE warned while performing #<COMPILE-OP NIL {12BC57D9}> on
   #<CL-SOURCE-FILE "quid-pro-quo" "metaclass">.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE823))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE823)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE823))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG
;        ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT.
;          (THE # SB-PCL::.DFUN-MORE-COUNT.)))
;        :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))
; 
; caught STYLE-WARNING:
;   The variable READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE841))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE841)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE841))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG
;        ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT.
;          (THE # SB-PCL::.DFUN-MORE-COUNT.)))
;        :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))
; 
; caught STYLE-WARNING:
;   The variable READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE900))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE900)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE900))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG
;        ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT.
;          (THE # SB-PCL::.DFUN-MORE-COUNT.)))
;        :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))
; 
; caught STYLE-WARNING:
;   The variable READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE918))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE918)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE918))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG
;        ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT.
;          (THE # SB-PCL::.DFUN-MORE-COUNT.)))
;        :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))
; 
; caught STYLE-WARNING:
;   The variable READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE936))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE936)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE936))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG
;        ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT.
;          (THE # SB-PCL::.DFUN-MORE-COUNT.)))
;        :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))
; 
; caught STYLE-WARNING:
;   The variable READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable WRITER-OBJECT is defined but never used.
; compiling file "/Users/greg/Documents/Lisp-community/dbc/src/system-connections.lisp" (written 27 APR 2011 10:54:14 AM):
; compiling (IN-PACKAGE #:QUID-PRO-QUO.SYSTEM)
; compiling (DEFSYSTEM-CONNECTION QUID-PRO-QUO.SLOT-VALUE-INVARIANTS ...)

; /Users/greg/.cache/common-lisp/sbcl-1.0.47-macosx-x86/Users/greg/Documents/Lisp-community/dbc/src/ASDF-TMP-system-connections.fasl written
; compilation finished in 0:00:00.224
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE954))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE954)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE954))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG
;        ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT.
;          (THE # SB-PCL::.DFUN-MORE-COUNT.)))
;        :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))
; 
; caught STYLE-WARNING:
;   The variable READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable WRITER-OBJECT is defined but never used.
; Registering #<SYSTEM-CONNECTION "quid-pro-quo.slot-value-invariants">
STYLE-WARNING:
   Implicitly creating new generic function EFFECTIVE-KEYWORD-NAME.
STYLE-WARNING: Implicitly creating new generic function APPLY-LAMBDA/CC.
STYLE-WARNING: Implicitly creating new generic function ENABLED-P.
STYLE-WARNING: Implicitly creating new generic function LOG.LEVEL.
STYLE-WARNING: Implicitly creating new generic function (SETF LOG.LEVEL).
STYLE-WARNING:
   Implicitly creating new generic function COMPILE-TIME-ENABLED-P.
STYLE-WARNING:
   Implicitly creating new generic function LOG.COMPILE-TIME-LEVEL.
STYLE-WARNING:
   Implicitly creating new generic function (SETF LOG.COMPILE-TIME-LEVEL).
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1173))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1173)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1173))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (MULTIPLE-VALUE-PROG1
;           (PROGN
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-0 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;             :REST-ARG (#) :MORE-ARG
;             (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.)))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
STYLE-WARNING: Implicitly creating new generic function ENQUEUE.
STYLE-WARNING: Implicitly creating new generic function DEQUEUE.
STYLE-WARNING: Implicitly creating new generic function PEEK-QUEUE.
STYLE-WARNING: Implicitly creating new generic function QUEUE-EMPTY-P.
STYLE-WARNING: Implicitly creating new generic function QUEUE-FULL-P.
STYLE-WARNING: Implicitly creating new generic function QUEUE-COUNT.
STYLE-WARNING:
   Implicitly creating new generic function RANDOM-QUEUE-ELEMENT.
STYLE-WARNING:
   Implicitly creating new generic function
   CALL-FOR-ALL-ELEMENTS-WITH-INDEX.
STYLE-WARNING: Implicitly creating new generic function GROW-QUEUE.
STYLE-WARNING: Implicitly creating new generic function MOVE-TAIL.
STYLE-WARNING: Implicitly creating new generic function MOVE-HEAD.
STYLE-WARNING: Implicitly creating new generic function QUEUE->LIST.
STYLE-WARNING:
   Implicitly creating new generic function ENQUEUE-OR-MOVE-TO-FRONT.
STYLE-WARNING: Implicitly creating new generic function EXPLAIN.
STYLE-WARNING:
   Implicitly creating new generic function RESOLVE-DEPENDENCIES.
STYLE-WARNING: Implicitly creating new generic function RUN-TEST-LAMBDA.
STYLE-WARNING: Implicitly creating new generic function FAIL-INVARIANT.
; in:
;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 SB-PCL::EFFECTIVE-METHOD-GENSYM-3
;          #:G1272 #:G1273 #:G1274 SB-PCL::EFFECTIVE-METHOD-GENSYM-4
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-5 #:G1275 #:G1276
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-6 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1244))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1244)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1244))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-9 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in:
;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 SB-PCL::EFFECTIVE-METHOD-GENSYM-3
;          #:G1375 #:G1376 #:G1377 SB-PCL::EFFECTIVE-METHOD-GENSYM-4
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-5 #:G1378 #:G1379
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-6 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1347))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1347)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1347))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-9 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
..; in:
  ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 SB-PCL::EFFECTIVE-METHOD-GENSYM-3
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-4 SB-PCL::EFFECTIVE-METHOD-GENSYM-5
  ;          #:G1498 #:G1499 #:G1500 SB-PCL::EFFECTIVE-METHOD-GENSYM-6
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-7 #:G1501 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1460))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1460)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1460))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (IF #
;                  NIL
;                  #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-13 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
.; in:
 ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 #:G1593 #:G1594 #:G1595
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-3 SB-PCL::EFFECTIVE-METHOD-GENSYM-4
 ;          #:G1596 #:G1597 SB-PCL::EFFECTIVE-METHOD-GENSYM-5
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-6 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1575))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1575)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1575))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-7 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
....; in:
    ;      LAMBDA (#:G1649 SB-PCL::EFFECTIVE-METHOD-GENSYM-0
    ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-1 SB-PCL::EFFECTIVE-METHOD-GENSYM-2
    ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-3)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1646))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1646)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1646))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF #:G1649
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;            SB-PCL::EFFECTIVE-METHOD-GENSYM-3 T :REQUIRED-ARGS (SB-PCL::.ARG0.)
;            :REST-ARG ((SB-C:%LISTIFY-REST-ARGS SB-PCL::.DFUN-MORE-CONTEXT. #))
;            :MORE-ARG (SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in:
;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 #:G1698
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-1 SB-PCL::EFFECTIVE-METHOD-GENSYM-2
;          #:G1699 SB-PCL::EFFECTIVE-METHOD-GENSYM-3)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1695))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1695)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1695))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-INVARIANTS-P*
;           (MULTIPLE-VALUE-PROG1
;               (PROGN
;                (LET #
;                  #)
;                (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;                 SB-PCL::EFFECTIVE-METHOD-GENSYM-1 NIL :REQUIRED-ARGS # :REST-ARG
;                 NIL :MORE-ARG NIL))
;             (LET (#)
;               (IF #
;                   NIL
;                   #)))
;           (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;            SB-PCL::EFFECTIVE-METHOD-GENSYM-3 NIL :REQUIRED-ARGS
;            (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL)))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
X; in:
 ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 #:G1718
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-1 #:G1719
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 SB-PCL::EFFECTIVE-METHOD-GENSYM-3
 ;          #:G1720 SB-PCL::EFFECTIVE-METHOD-GENSYM-4 #:G1721
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-5)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1715))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1715)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1715))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-INVARIANTS-P*
;           (MULTIPLE-VALUE-PROG1
;               (PROGN
;                (LET #
;                  #
;                  #)
;                (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;                 SB-PCL::EFFECTIVE-METHOD-GENSYM-2 NIL :REQUIRED-ARGS # :REST-ARG
;                 NIL :MORE-ARG NIL))
;             (LET (#)
;               (IF #
;                   NIL
;                   #)
;               (IF #
;                   NIL
;                   #)))
;           (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;            SB-PCL::EFFECTIVE-METHOD-GENSYM-5 NIL :REQUIRED-ARGS
;            (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL)))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
.; in:
 ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
 ;          #:G1770 #:G1771 #:G1772 SB-PCL::EFFECTIVE-METHOD-GENSYM-2
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-3 #:G1773
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-4 #:G1774 #:G1775 #:G1776 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1752))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1752)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1752))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-5 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1807))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1807)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1807))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 NIL :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG NIL :MORE-ARG NIL))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
..; in:
  ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 #:G1858 #:G1859 #:G1860
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-3 SB-PCL::EFFECTIVE-METHOD-GENSYM-4
  ;          #:G1861 SB-PCL::EFFECTIVE-METHOD-GENSYM-5
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-6 #:G1862 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1840))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1840)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1840))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-7 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1895))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1895)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1895))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 NIL :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG NIL :MORE-ARG NIL))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
..; in:
  ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 SB-PCL::EFFECTIVE-METHOD-GENSYM-1
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-2 SB-PCL::EFFECTIVE-METHOD-GENSYM-3
  ;          #:G1966 #:G1967 #:G1968 SB-PCL::EFFECTIVE-METHOD-GENSYM-4
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-5 #:G1969
  ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-6 #:G1970 ...)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE1938))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE1938)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE1938))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-POSTCONDITIONS-P*
;           (PROGN
;            (IF NIL
;                NIL
;                (PROGN #))
;            (LET (# #)
;              (IF #
;                  NIL
;                  #)
;              (IF #
;                  NIL
;                  #)
;              (QUID-PRO-QUO:RESULTS)))
;           (PROGN
;            (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;                (PROGN #)
;                NIL)
;            (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;             SB-PCL::EFFECTIVE-METHOD-GENSYM-9 NIL :REQUIRED-ARGS
;             (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL))))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE2014))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE2014)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE2014))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 NIL :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG NIL :MORE-ARG NIL))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
....f.; in:
      ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 #:G2035
      ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-1 SB-PCL::EFFECTIVE-METHOD-GENSYM-2
      ;          #:G2036 SB-PCL::EFFECTIVE-METHOD-GENSYM-3)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE2032))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE2032)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE2032))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (IF QUID-PRO-QUO::*CHECK-INVARIANTS-P*
;           (MULTIPLE-VALUE-PROG1
;               (PROGN
;                (LET #
;                  #)
;                (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;                 SB-PCL::EFFECTIVE-METHOD-GENSYM-1 NIL :REQUIRED-ARGS # :REST-ARG
;                 NIL :MORE-ARG NIL))
;             (LET (#)
;               (IF #
;                   NIL
;                   #)))
;           (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;            SB-PCL::EFFECTIVE-METHOD-GENSYM-3 NIL :REQUIRED-ARGS
;            (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL)))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
.; in:
 ;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 #:G2055 #:G2056 #:G2057
 ;          SB-PCL::EFFECTIVE-METHOD-GENSYM-1)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE2052))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE2052)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE2052))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (PROGN
;        (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;            (PROGN
;             (LET* #
;               #))
;            NIL)
;        (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;         SB-PCL::EFFECTIVE-METHOD-GENSYM-1 NIL :REQUIRED-ARGS
;         (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL)))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in:
;      LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0 #:G2076 #:G2077 #:G2078
;          SB-PCL::EFFECTIVE-METHOD-GENSYM-1)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE2073))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE2073)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE2073))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (PROGN
;        (IF QUID-PRO-QUO::*CHECK-PRECONDITIONS-P*
;            (PROGN
;             (LET* #
;               #))
;            NIL)
;        (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;         SB-PCL::EFFECTIVE-METHOD-GENSYM-1 NIL :REQUIRED-ARGS
;         (SB-PCL::.ARG0. SB-PCL::.ARG1.) :REST-ARG NIL :MORE-ARG NIL)))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
; in: LAMBDA (SB-PCL::EFFECTIVE-METHOD-GENSYM-0)
;     (LET* ((QUID-PRO-QUO::READER-OBJECT (CAR #:WHOLE2094))
;            (QUID-PRO-QUO::WRITER-OBJECT (CAR (CDR #:WHOLE2094)))
;            (SB-PCL::.IGNORE. (CDR (CDR #:WHOLE2094))))
;       (DECLARE (IGNORE SB-PCL::.IGNORE.))
;       NIL
;       (SB-PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST
;        SB-PCL::EFFECTIVE-METHOD-GENSYM-0 NIL :REQUIRED-ARGS (SB-PCL::.ARG0.)
;        :REST-ARG NIL :MORE-ARG NIL))
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::READER-OBJECT is defined but never used.
; 
; caught STYLE-WARNING:
;   The variable QUID-PRO-QUO::WRITER-OBJECT is defined but never used.
...
 Did 23 checks.
    Pass: 21 (91%)
    Skip: 0 ( 0%)
    Fail: 2 ( 8%)

 Failure Details:
 --------------------------------
 SHOULD-FAIL-INVARIANT-AFTER-SETTING-SLOT-VALUE []: 
      Failed to signal a AFTER-INVARIANT-ERROR.
 --------------------------------
 --------------------------------
 SHOULD-FAIL-INVARIANT-AFTER-WRITER []: 
      Unexpected Error: #<AFTER-INVARIANT-ERROR {126BD8F1}>
Invariant violation on #<TEST-1 {124EA8B9}> after #<STANDARD-WRITER-METHOD (SETF MY-SLOT), slot:MY-SLOT, (T
                                                                                                          TEST-1) {11D4EDE1}>...
 --------------------------------

; 
; compilation unit finished
;   caught 45 STYLE-WARNING conditions
;   printed 2 notes

many failed tests on LispWorks

This seems similar to #1 and #2, but with an even less helpful stack, etc. Many tests fail with “Error: malformed”. Here’s the backtrace:

Call to ERROR
Call to CLOS::SIMPLE-WALK-FORM
Call to CLOS::SIMPLE-WALK-FORM
Call to CLOS::SIMPLE-WALK-FORM
Call to CLOS::SIMPLE-WALK-FORM
Call to CLOS::SIMPLE-WALK-FORM
Call to CLOS::SIMPLE-WALK-FORM
Call to CLOS::MAKE-EFFECTIVE-METHOD-FUNCTION
Call to CLOS::COMPUTE-EFFECTIVE-METHOD-FUNCTION
Call to CLOS::COMPUTE-EFFECTIVE-METHOD-FROM-METHODS
Call to CLOS::I-DEMAND-LOOKUP-METHOD-4
Call to CLOS::DCODE-MISS-A
Call to (HARLEQUIN-COMMON-LISP:SUBFUNCTION (LABELS IT.BESE.FIVEAM::RUN-IT) (METHOD IT.BESE.FIVEAM::RUN-TEST-LAMBDA (IT.BESE.FIVEAM::TEST-CASE)))
Call to (METHOD IT.BESE.FIVEAM::RUN-TEST-LAMBDA (IT.BESE.FIVEAM::TEST-CASE))
Call to (METHOD IT.BESE.FIVEAM::RUN-RESOLVING-DEPENDENCIES (IT.BESE.FIVEAM::TEST-CASE))
Call to (HARLEQUIN-COMMON-LISP:SUBFUNCTION IT.BESE.FIVEAM::RUN-TESTS (METHOD IT.BESE.FIVEAM::%RUN (IT.BESE.FIVEAM::TEST-SUITE)))
Call to (METHOD IT.BESE.FIVEAM::%RUN (IT.BESE.FIVEAM::TEST-SUITE))
Call to (HARLEQUIN-COMMON-LISP:SUBFUNCTION 1 RUN)
Call to RUN!
Call to FUNCALL
Interpreted call to (METHOD ASDF:PERFORM :AFTER (ASDF:TEST-OP (EQL #<ASDF:SYSTEM "quid-pro-quo">)))
Call to CLOS::METHOD-COMBINATION-TEMPLATE
Call to (HARLEQUIN-COMMON-LISP:SUBFUNCTION 1 (METHOD ASDF:OPERATE (T T)))
Call to (METHOD ASDF:OPERATE (T T))
Call to CLOS::METHOD-COMBINATION-TEMPLATE
Call to ASDF:TEST-SYSTEM
Call to EVAL
Call to CAPI::CAPI-TOP-LEVEL-FUNCTION
Call to CAPI::INTERACTIVE-PANE-TOP-LOOP
Call to MP::PROCESS-SG-FUNCTION

allow for multiple pre- and postcondition checks at same level

Currently, if there are multiple conditions at the same level, we end up doing something like this:

(defmethod put :ensure "stack not empty & ITEM added to top" (item (object stack))
  (and (not (emptyp object))
       (eq (item object) item)))

However, this leads to less-specific than ideal condition reports. Something like either

(defmethod put :ensure "stack not empty" (item (object stack))
  (not (emptyp object)))
(defmethod put :ensure "ITEM added to top" (item (object stack))
  (eq (item object) item))

(defmethod put :ensure (item (object stack))
  (contract-check (not (emptyp object)) "stack not empty")
  (contract-check (eq (item object) item) "ITEM added to top"))

would allow us to give more specific condition reports.

many failed tests on CMUCL

Many tests fail on CMUCL (2010-11 – 2011-04 at least) wit “Invalid number of arguments: 1”. This looks similar to #1 involving SBCL (and, indeed, I mentioned it there), but even after #1 was fixed, this still happens. And I’m fairly certain this happened before #1 was fixed, so despite the method-function look of LAMBDA (.METHOD-ARGS. .NEXT-METHODS.) in the backtrace, I don’t think it was caused by adding MAKE-METHOD-LAMBDA.

Backtrace:

  0: ("LAMBDA (.METHOD-ARGS. .NEXT-METHODS.)" 1 (NIL #<QUID-PRO-QUO-TEST::TEST-2 {494C20E5}>) #<unused-arg>)[:EXTERNAL]
      Locals:
        #:G11 = 1
        #:G12 = (NIL #<QUID-PRO-QUO-TEST::TEST-2 {494C20E5}>)
  1: ("LAMBDA (G5182 G5183 G5184 G5185 G5186 G5187 G5188 G5189 G5190)" #<#1=unused-arg> #<#1#> NIL #<QUID-PRO-QUO-TEST::TEST-2 {494C20E5}>)
      Locals:
        PCL::.ARG0. = NIL
        PCL::.ARG1. = #<QUID-PRO-QUO-TEST::TEST-2 {494C20E5}>
  2: ("LAMBDA NIL")
  3: ((LABELS IT.BESE.FIVEAM::RUN-IT))
  4: ((METHOD IT.BESE.FIVEAM::RUN-TEST-LAMBDA NIL (IT.BESE.FIVEAM::TEST-CASE)) (#(5 7 6 4 3) . #()) #<unused-arg> ..)
      Locals:
        PCL::.PV-CELL. = (#(5 7 6 4 3) . #())
        PCL::.PV. = #(5 7 6 4 3)
        PCL::.SLOTS0. = #(QUID-PRO-QUO-TEST::SHOULD-FAIL-ON-INVARIANT-OF-SUPERCLASS "" NIL ..)
        IT.BESE.FIVEAM:TEST = #<IT.BESE.FIVEAM::TEST-CASE ..>
  5: ((METHOD IT.BESE.FIVEAM::RUN-RESOLVING-DEPENDENCIES NIL (IT.BESE.FIVEAM::TEST-CASE)) (#(0 2 3 3) . #()) #<unused-arg> ..)
  6: ((FLET IT.BESE.FIVEAM::RUN-TESTS))
  7: ((METHOD IT.BESE.FIVEAM::%RUN NIL (IT.BESE.FIVEAM::TEST-SUITE)) (#(5 6 4 3) . #()) #<unused-arg> #<IT.BESE.FIVEAM::TEST-SUITE QUID-PRO-QUO-TEST::TESTS {48866B55}>)
  8: ("DEFUN RUN")
  9: (IT.BESE.FIVEAM:RUN! QUID-PRO-QUO-TEST::TESTS)
 10: ("LAMBDA (G4976 G4977 G4978)" #<#1=unused-arg> #<#1#> #<ASDF:TEST-OP NIL {4892CFC5}> #<ASDF:SYSTEM "quid-pro-quo">)
 11: ((FLET #:G24))
 12: ((METHOD ASDF:OPERATE NIL (T T)) #<#1=unused-arg> #<#1#> ASDF:TEST-OP "quid-pro-quo" ...)
 13: ("DEFUN OPERATE-ON-SYSTEM")
 14: ((FLET SWANK-BACKEND:CALL-WITH-COMPILATION-HOOKS) #<Closure Over Function "DEFUN OPERATE-ON-SYSTEM" {4892CC01}>)
 --more--

test failures on SBCL and CMUCL

(asdf:test-system :quid-pro-quo) fails a number of tests on SBCL 1.0.47 with “invalid number of arguments: 2”, but I can't decipher it (CMUCL gives a similar error). There must be something wrong with this part of metaclass.lisp:

(defun passes-invariants-p (object)
  (and (passes-slot-type-invariants-p object)
       (passes-class-invariants-p object)))

(defun add-reader-invariant (reader class)
  (add-method (ensure-generic-function reader
                                       :lambda-list '(object)
                                       :method-combination '(contract))
              (make-instance 'standard-method
                             :qualifiers '(invariant)
                             :lambda-list '(object)
                             :specializers (list class)
                             :function #'passes-invariants-p)))

(defun add-writer-invariant (writer class)
  (add-method (ensure-generic-function writer
                                       :lambda-list '(new-value object)
                                       :method-combination '(contract))
              (make-instance 'standard-method
                             :qualifiers '(invariant)
                             :lambda-list '(new-value object)
                             :specializers (list (find-class t) class)
                             :function (lambda (new-value object)
                                         (declare (ignore new-value))
                                         (passes-invariants-p object)))))

But it seems to me that PASSES-INVARIANTS-P always gets called with one argument.

And here's the stack:

  0: (QUID-PRO-QUO::PASSES-INVARIANTS-P (#<QUID-PRO-QUO-TEST::TEST-1 {1202EF91}>))[:EXTERNAL]
  1: ((SB-PCL::EMF QUID-PRO-QUO-TEST::MY-SLOT) #<unavailable argument> #<unavailable argument> #<QUID-PRO-QUO-TEST::TEST-1 {1202EF91}>)
  2: ((SB-PCL::FAST-METHOD QUID-PRO-QUO-TEST:TEST-QPQ :PRECONDITION "first arg needs non-zero my-slot" (QUID-PRO-QUO-TEST::TEST-1 QUID-PRO-QUO-TEST::TEST-1)) ..)
  3: ((SB-PCL::EMF QUID-PRO-QUO-TEST:TEST-QPQ) #<unavailable argument> #<unavailable argument> #<QUID-PRO-QUO-TEST::TEST-1 {1202EF91}> #<QUID-PRO-QUO-TEST::TEST-1 {1203F8E1}>)
  4: ((LAMBDA ()))
  5: ((LABELS IT.BESE.FIVEAM::RUN-IT))
  6: ((SB-PCL::FAST-METHOD IT.BESE.FIVEAM::RUN-TEST-LAMBDA (IT.BESE.FIVEAM::TEST-CASE)) ..)
  7: ((SB-PCL::FAST-METHOD IT.BESE.FIVEAM::RUN-RESOLVING-DEPENDENCIES (IT.BESE.FIVEAM::TEST-CASE)) ..)
  8: ((FLET IT.BESE.FIVEAM::RUN-TESTS))
  9: ((SB-PCL::FAST-METHOD IT.BESE.FIVEAM::%RUN (IT.BESE.FIVEAM::TEST-SUITE)) #<unavailable argument> #<unavailable argument> #<IT.BESE.FIVEAM::TEST-SUITE QUID-PRO-QUO-TEST::TESTS {12A77DD1}>)
 10: ((LAMBDA ()))
 11: (IT.BESE.FIVEAM:RUN! QUID-PRO-QUO-TEST::TESTS)
 12: ((SB-PCL::EMF ASDF:PERFORM) #<unavailable argument> #<unavailable argument> #<ASDF:TEST-OP NIL {133899B1}> #<ASDF:SYSTEM "quid-pro-quo">)
 13: ((LAMBDA ()))
 14: ((FLET SB-THREAD::WITH-RECURSIVE-LOCK-THUNK))
 15: ((FLET SB-C::WITH-IT))
 16: ((SB-PCL::FAST-METHOD ASDF:OPERATE (T T)) #<unused argument> #<unused argument> ASDF:TEST-OP "quid-pro-quo")
 17: ((SB-PCL::EMF ASDF:OPERATE) #<unused argument> #<unused argument> ASDF:TEST-OP "quid-pro-quo" 4717675 0)
 18: ((LAMBDA ()))
 19: ((FLET SWANK-BACKEND:CALL-WITH-COMPILATION-HOOKS) #<CLOSURE (LAMBDA #) {133896DD}>)
 --more--

support textual contracts

Some preconditions, postconditions and invariants are hard to specify in coded form yet still contain information about the contract. It would be nice if there'd be some way to write a textual contract in there instead for reference to those that use or implement the class/method.

use contract body as description when there is no documentation

Should make condition reports (and eventually documentation) more helpful, and eliminate the need to duplicate simple contracts as strings.

postcondition must have access to result

There's currently no way to get access to the result of the primary method from the postcondition, however most postconditions are intended to check that the result meets particular criteria, so it's not so useful without that.

Will not build on SBCL 1.1.17

Starting with (the not yet released) version 1.1.17, SBCL will no longer have sb-int:arg-list.

See http://cl-test-grid.appspot.com/blob?key=cc9ry6mb3y for the future error.

include contracts in documentation

We can specialize DOCUMENTATION on CONTRACTED-CLASS, but it might be harder to get the function documentation, since we don't (yet) have a subclass of STANDARD-GENERIC-FUNCTION.

need something akin to Eiffel’s `old` notation

In a postcondition, it is useful to be able to refer to the state of things before the method ran. Eiffel does this through the use of old ⟦expression⟧. EG, VECTOR-PUSH-EXTEND might have a postcondition like:

(defmethod vector-push-extend :ensure (new-element vector &optional extension)
  (= (length vector) (1+ (old (length vector)))))

in which the value of (old (length vector)) needs to be calculated ahead of time.

NB: It has to be calculated independently of the precondition, since it’s possible to disable precondition checking without disabling postcondition checking.

make it easy to switch different assertions on and off

It's common to want to turn off postcondition (and maybe invariant) checks for third-party libraries. It should be easy for developers to control what is enabled on a per-package or per-asdf-system basis. Creating WITH-CONTRACTS-ENABLED to use around LOAD and adding in hooks to make it easy to use with ASDF.

We also have to make it easy to use big switches, to distinguish in-development from production, and any other arbitrary situations the developer may want different handling for.

sbcl method-combination rewrite

Hi,

My method-combination rewrite has, unfortunately, broken quid-pro-quo. It's (presumably) a similar issue to that already affecting Lispworks, Allegro and CLISP: the defguarantee on make-instance at the end of metaclass.lisp tries to change the method combination of make-instance, which is not supported in my rewrite.

We could talk about whether it should be! But given that existing practice is against you, please could you #-sbcl out that defguarantee for now?

Thanks,

Christophe

fail to load for sbcl-2.0.1-1.1

OS: OpenSuse

debugger output

failed AVER:
    (GETHASH SB-PCL::GF
             (SB-PCL::METHOD-COMBINATION-%GENERIC-FUNCTIONS
              SB-PCL::OLD-MC))
This is probably a bug in SBCL itself. (Alternatively, SBCL
might have been corrupted by bad user code, e.g. by an undefined
Lisp operation like (FMAKUNBOUND 'COMPILE), or by stray pointers
from alien code or from unsafe Lisp code; or there might be a
bug in the OS or hardware that SBCL is running on.) If it seems
to be a bug in SBCL itself, the maintainers would like to know
about it. Bug reports are welcome on the SBCL mailing lists,
which you can find at <http://sbcl.sourceforge.net/>.
   [Condition of type SB-INT:BUG]

integrate with LOOM

Not that anyone uses it, but it'd be nice to support LOOM's generic SLOT-VALUE. Invariants can be treated as postconditions on SLOT-VALUE, which should throw exceptions closer to where a contract is violated (in cases where LOOM is used).

Recommend Projects

React

A declarative, efficient, and flexible JavaScript library for building user interfaces.
Vue.js

🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
Typescript

TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
TensorFlow

An Open Source Machine Learning Framework for Everyone
Django

The Web framework for perfectionists with deadlines.
Laravel

A PHP framework for web artisans
D3

Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

javascript

JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
web

Some thing interesting about web. New door for the world.
server

A server is a program made to process requests and deliver data to clients.
Machine learning

Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
Visualization

Some thing interesting about visualization, use data art
Game

Some thing interesting about game, make everyone happy.

Recommend Org

Facebook

We are working to build community through open source technology. NB: members must have two-factor auth.
Microsoft

Open source projects and samples from Microsoft.
Google

Google ❤️ Open Source for everyone.
Alibaba

Alibaba Open Source for everyone
D3

Data-Driven Documents codes.
Tencent

China tencent open source team.