From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
---
 src/bigloo/debug.sch | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 src/bigloo/debug.sch

(limited to 'src/bigloo/debug.sch')

diff --git a/src/bigloo/debug.sch b/src/bigloo/debug.sch
new file mode 100644
index 0000000..9b53c84
--- /dev/null
+++ b/src/bigloo/debug.sch
@@ -0,0 +1,54 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/bigloo/debug.sch                 */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Thu May 29 06:46:33 2003                          */
+;*    Last change :  Tue Nov  2 14:31:45 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Simple debug facilities                                          */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    directives                                                       */
+;*---------------------------------------------------------------------*/
+(directives
+   (import skribe_debug))
+
+;*---------------------------------------------------------------------*/
+;*    when-debug ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-macro (when-debug level . exp)
+   (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+       `(if (>= *skribe-debug* ,level) (begin ,@exp))
+       #unspecified))
+
+;*---------------------------------------------------------------------*/
+;*    with-debug ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-macro (with-debug level lbl . arg*)
+   (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+       `(%with-debug ,level ,lbl (lambda () (begin ,@arg*)))
+       `(begin ,@arg*)))
+
+;*---------------------------------------------------------------------*/
+;*    with-push-trace ...                                              */
+;*---------------------------------------------------------------------*/
+(define-macro (with-push-trace lbl . arg*)
+   (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+       (let ((r (gensym)))
+	  `(let ()
+	      (c-push-trace ,lbl)
+	      (let ((,r ,@arg*))
+		 (c-pop-trace)
+		 ,r)))
+       `(begin ,@arg*)))
+
+;*---------------------------------------------------------------------*/
+;*    debug-item ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-expander debug-item
+   (lambda (x e)
+      (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+	  `(debug-item ,@(map (lambda (x) (e x e)) (cdr x)))
+	  #unspecified)))
-- 
cgit v1.2.3