;;; -*- Mode: Lisp -*-
;;;
;;; $Header: /home/gene/library/website/docsrc/amo/RCS/lazy.lisp,v 395.1 2008/04/20 17:25:45 gene Exp $
;;;
;;; Copyright (c) 2005 Gene Michael Stover.  All rights reserved.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
;;; USA
;;;

(defpackage "LAZY"
  (:use "COMMON-LISP"))
(in-package "LAZY")

(export 'force)
(export 'suspend)
(export '*suspension-counters*)
(export '*force-counters*)
(export 'clear-counters)
(export 'print-counters)

(defvar *suspension-counters* (make-hash-table))
(defvar *force-counters* (make-hash-table))

(defun force (fn)
  (declare (type function fn))
  (funcall fn))

(defmacro suspend (tag &rest body)
  (incf (gethash tag lazy:*suspension-counters* 0))
  `#'(lambda ()
       (incf (gethash ',tag lazy:*force-counters* 0))
       ,@body))

(defun clear-counters ()
  (clrhash *suspension-counters*)
  (clrhash *force-counters*))

(defun print-counters ()
  (format t "~&~30A  ~5D  ~5D" "tag" "suspe" "force")
  (maphash #'(lambda (tag suspensions)
	       (format t "~&~30A ~5D ~5D" tag suspensions
		       (gethash tag *force-counters* 0)))
	   *suspension-counters*))

;;; --- end of file ---