debug.lisp

;;
;;  CL-DEBUG
;;
;;  Copyright 2014 LowH <code@lowh.net>
;;
;;  Permission to use, copy, modify, and distribute this software for any
;;  purpose with or without fee is hereby granted, provided that the above
;;  copyright notice and this permission notice appear in all copies.
;;
;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(in-package :cl-user)

(defpackage :cl-debug
  (:nicknames :debug)
  (:use :cl)
  (:export
   #:debug-p))

(in-package :cl-debug)

(defvar *debug* nil)
(declaim (type list *debug*))

(defmacro debug-p (what)
  (labels ((walk (x)
	     (etypecase x
	       (cons `(,(car x) ,@(mapcar #'walk (cdr x))))
	       (keyword `(find ,x *debug*))
	       (symbol `(find ',x *debug*)))))
    (walk what)))

(defsetf debug-p (what) (value)
  `(progn (if ,value
	      (pushnew (the symbol ,what) *debug*)
	      (setq *debug* (remove (the symbol ,what) *debug*)))
	  ,value))