anchor.diff:        (b-error "Invalid sublocation for ~S: ~{~S~^, ~}."
                  loc-class (set-difference sublocs (location-class-sublocations loc-class)))))
       (values clhs crhs loc-class)))
  -;;;;
  -;;;; END NEW APPROACH
  -;;;;
   
   (defun canonicalize-species-type (x)
     (unless (species-type-p x)
       (b-error "Expecting a species-type, but received ~S." x))
     x)
  +
  +;;;
  +;;; END ARGUMENT PARSING
  +;;;
  +
  +(hide-classes reaction-type-requirement |REACTION-TYPE.LHS-REQUIREMENTS| |REACTION-TYPE.RHS-REQUIREMENTS|)
  +
  +
  +(defoperator -> ((+ 2 (operator-precedence '+)) :xfy)
  +  (lhs rhs)
  +  (if (localization-p lhs)
  +      [reaction-type lhs.entity rhs lhs.location-class]
  +    [reaction-type lhs rhs]))
  +
  +(defoperator <- ((+ 2 (operator-precedence '+)) :xfy)
  +  (rhs lhs)
  +  (if (localization-p lhs)
  +      [reaction-type lhs.entity rhs lhs.location-class]
  +    [reaction-type lhs rhs]))
  +
  +
  +;;;; ;;;
  +;;;; ;;;
  +;;;; ;;;  REVERSIBLE-REACTION:
  +;;;; ;;;
  +(defcon reversible-reaction ()
  +  ((lhs reaction-type)
  +   (rhs reaction-type) &optional (location-class := nil)
  +   &property (fwd reaction-type :#= [reaction-type .lhs .rhs .location-class])
  +             (rev reaction-type :#= [reaction-type .rhs .lhs .location-class]))
  +  (multiple-value-bind (clhs crhs loc-class)
  +      (parse-reaction-type-arguments lhs rhs location-class '<-> #'canonicalize-species-type)
  +   (setf .lhs (apply #'s+ clhs)
  +         .rhs (apply #'s+ crhs)
  +         .location-class loc-class)))
  +
  +
  +(defield reversible-reaction.kf ()
  +  .fwd.k)
  +
  +(defield (setf reversible-reaction.kf) (value)
  +  (setf .fwd.k value))
  +
  +(defield reversible-reaction.kr ()
  +  .rev.k)
  +
  +(defield (setf reversible-reaction.kr) (value)
  +  (setf .rev.k value))
  +
  +(defoperator <-> ((+ 2 (operator-precedence '+)) :xfy)
  +  (lhs rhs)
  +  (if (localization-p lhs)
  +      [reversible-reaction lhs.entity rhs lhs.location-class]
  +    [reversible-reaction lhs rhs]))
  +
  +
  +(defmethod print-concept ((rt reversible-reaction) &optional stream)
  +  (if *debug-printing* (call-next-method)
  +    (print-math-expression rt stream)))
  +
  +(defmethod print-math-expression ((rr reversible-reaction) &optional 
  +                                  (stream *standard-output*) (outer-op t))
  +  (with-print-context rr
  +    (let ((lhs-printable (if (find-if #'species-type-p rr.lhs.vars) rr.lhs
  +                           [localization rr.lhs rr.location-class])))
  +      (print-operator '<-> (list lhs-printable rr.rhs) stream outer-op))))
  +
  +
  +
  +;;;; (defield reaction-type.lhs-species (loc req)
  +;;;;   (get-reaction-type-species object loc req .reactants))
  +
  +;;;; (defield (setf reaction-type.lhs-species) (value loc selector)
  +;;;;   (setf (get-reaction-type-species object loc selector .reactants) value))
  +
  +;;;; (defield reaction-type.rhs-species (loc selector)
  +;;;;   (get-reaction-type-species object loc selector .products))
  +
  +;;;; (defield (setf reaction-type.rhs-species) (value loc req)
  +;;;;   (setf (get-reaction-type-species object loc req .products) value))
  +
  +;;;; (defun get-reaction-type-species (rt loc selector ht)
  +;;;;   (let* ((key (etypecase selector
  +;;;;                 (reaction-type-requirement nil)
  +;;;;                 (location-requirement      ?.location-requirement)
  +;;;;                 (species-type              ?.species-type)))
  +;;;;          (retval (assoc (gethash loc ht) selector :key key)))
  +;;;;     (unless retval (b-error "Invalid selector (~S). No matching species in ~S." selector rt))))
  +
  +;;;; (defun (setf get-reaction-type-species) (rct rt loc req ht)
  +;;;;   (assert (and (species-p rct) (eq req.reaction-type rt)))
  +;;;;   (pushnew (cons req rct) (gethash loc ht) :key #'car))
  +
  +;;;; (defield reaction-type.satisfied-at (loc)
  +;;;;   (eq (length (gethash loc .reactants)) 
  +;;;;       (length .lhs-requirements)))
  +
   
   
   ;;;; (defun determine-reaction-type-location-class (defined-lclass lhs rhs)
  
positive.code: ;;;;     (when rt-arg 
  ;;;;       (unless (sum-expression-p rt-arg)
  ;;;;         (b-error "Invalid argument to reaction-type: ~S.  Expecting a {na A + nb B + nb C....}" rt-arg))
  ;;;;       rt-arg.(map-terms #'check-term))))
  
  (hide-classes reaction-type-requirement |REACTION-TYPE.LHS-REQUIREMENTS| |REACTION-TYPE.RHS-REQUIREMENTS|)
  
  
  (defoperator -> ((+ 2 (operator-precedence '+)) :xfy)
    (lhs rhs)
    (if (localization-p lhs)
        [reaction-type lhs.entity rhs lhs.location-class]
      [reaction-type lhs rhs]))
  
  (defoperator <- ((+ 2 (operator-precedence '+)) :xfy)
    (rhs lhs)
    (if (localization-p lhs)
        [reaction-type lhs.entity rhs lhs.location-class]
      [reaction-type lhs rhs]))
  
  
  ;;;; ;;;
  ;;;; ;;;
  ;;;; ;;;  REVERSIBLE-REACTION:
  ;;;; ;;;
  (defcon reversible-reaction ()
    ((lhs reaction-type)
     (rhs reaction-type) &optional (location-class := nil)
     &property (fwd reaction-type :#= [reaction-type .lhs .rhs .location-class])
               (rev reaction-type :#= [reaction-type .rhs .lhs .location-class]))
    (unless (math-expression-p lhs) {.lhs := {lhs}})
    (unless (math-expression-p rhs) {.rhs := {rhs}})
    {.location-class := (determine-reaction-type-location-class .location-class .lhs .rhs)})
  
  
  (defield reversible-reaction.kf ()
    .fwd.k)
  
  (defield (setf reversible-reaction.kf) (value)
    (setf .fwd.k value))
  
  (defield reversible-reaction.kr ()
    .rev.k)
  
  (defield (setf reversible-reaction.kr) (value)
    (setf .rev.k value))
  
  (defoperator <-> ((+ 2 (operator-precedence '+)) :xfy)
    (lhs rhs)
    (if (localization-p lhs)
        [reversible-reaction lhs.entity rhs lhs.location-class]
      [reversible-reaction lhs rhs]))
  
  
  (defmethod print-concept ((rt reversible-reaction) &optional stream)
    (if *debug-printing* (call-next-method)
      (print-math-expression rt stream)))
  
  (defmethod print-math-expression ((rr reversible-reaction) &optional 
                                    (stream *standard-output*) (outer-op t))
    (with-print-context rr
      (let ((lhs-printable (if (find-if #'species-type-p rr.lhs.vars) rr.lhs
                             [localization rr.lhs rr.location-class])))
        (print-operator '<-> (list lhs-printable rr.rhs) stream outer-op))))
  
  
  
  ;;;; (defield reaction-type.lhs-species (loc req)
  ;;;;   (get-reaction-type-species object loc req .reactants))
  
  ;;;; (defield (setf reaction-type.lhs-species) (value loc selector)
  ;;;;   (setf (get-reaction-type-species object loc selector .reactants) value))
  
  ;;;; (defield reaction-type.rhs-species (loc selector)
  ;;;;   (get-reaction-type-species object loc selector .products))
  
  ;;;; (defield (setf reaction-type.rhs-species) (value loc req)
  ;;;;   (setf (get-reaction-type-species object loc req .products) value))
  
  ;;;; (defun get-reaction-type-species (rt loc selector ht)
  ;;;;   (let* ((key (etypecase selector
  ;;;;                 (reaction-type-requirement nil)
  ;;;;                 (location-requirement      ?.location-requirement)
  ;;;;                 (species-type              ?.species-type)))
  ;;;;          (retval (assoc (gethash loc ht) selector :key key)))
  ;;;;     (unless retval (b-error "Invalid selector (~S). No matching species in ~S." selector rt))))
  
  ;;;; (defun (setf get-reaction-type-species) (rct rt loc req ht)
  ;;;;   (assert (and (species-p rct) (eq req.reaction-type rt)))
  ;;;;   (pushnew (cons req rct) (gethash loc ht) :key #'car))
  
  ;;;; (defield reaction-type.satisfied-at (loc)
  ;;;;   (eq (length (gethash loc .reactants)) 
  ;;;;       (length .lhs-requirements)))
  
  
negative.code: ;;; File: reaction-type.lisp
  ;;; Description:  
  
  ;;; $Id: reaction-type.lisp,v 1.6 2007/12/16 02:37:20 amallavarapu Exp $
  
  (in-package #I@library/biochem)
  
  