;;; Macros for the Species model

(in-package 'USER)



;;; This flips num-bits number of bits in the gene, but only bits in
;;; the specified range.

(defmacro mutate-bits (gene num-bits range)
  `(let ((eval-range ,range)) ; evaluate the if clause for the range.
     (dotimes (i ,num-bits ,gene)
       (let ((locus (random eval-range)))
	 (setf ,gene (logxor (ash 1 locus) ,gene))))))




;;; Ranks a generalism gene by the number of 1's in it.
(defmacro generalism-rank (gene) `(logcount ,gene))



(defmacro generate-prey-gene ()
  `(if *increasing-adaptive-space*
      (random (1+ GENEMASK))
    (random (expt 2 ADAPTZONE))))
  
(defmacro generate-generalism-gene ()
  `(if *increasing-adaptive-space*
      (if *niche-subdivision*
	  (random (1+ GENEMASK))
	(logior (random (1+ GENEMASK))
		(1- (expt 2 SUBDIVOFFSET))))
    (if *niche-subdivision*
	(random (expt 2 ADAPTZONE))
      (logior (random (expt 2 ADAPTZONE))
	      (1- (expt 2 SUBDIVOFFSET))))))


;;; If there is no increasing adaptive space allowed, then everyone,
;;; except the autotrophs should behave like they have smaller genes.
;;; That is, there the top portion of the gene should be and stay all
;;; 0's.

(defmacro generate-phenotype-gene () 
  `(if *increasing-adaptive-space*
      (random (1+ GENEMASK))
    (random (expt 2 ADAPTZONE))))


;;; Returns the number of bits that match on two genes.
(defmacro match (gene1 gene2)
  `(- GENESIZE (logcount (logxor ,gene1 ,gene2))))


(defmacro copy-org (to from the-orgs)
  `(let ((to-org (svref ,the-orgs ,to))
	 (from-org (svref ,the-orgs ,from)))
     (setf (organism-alive to-org) (organism-alive from-org))
     (setf (organism-prey to-org) (organism-prey from-org))
     (setf (organism-generalism to-org) (organism-generalism from-org))
     (setf (organism-phenotype to-org) (organism-phenotype from-org))
     (setf (organism-photosynth to-org) (organism-photosynth from-org))
     (setf (organism-last-meal to-org) (organism-last-meal from-org))
     (setf (organism-num-meals to-org) (organism-num-meals from-org))))