From 89a424521b753ee7c2c67ebdc957865657f647c4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Mon, 31 Oct 2005 16:16:54 +0000 Subject: Moved the STkLos and Bigloo code to `legacy'. Moved the STkLos and Bigloo code from `src' to `legacy'. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9 --- legacy/bigloo/debug.sch | 54 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 legacy/bigloo/debug.sch (limited to 'legacy/bigloo/debug.sch') diff --git a/legacy/bigloo/debug.sch b/legacy/bigloo/debug.sch new file mode 100644 index 0000000..9b53c84 --- /dev/null +++ b/legacy/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