Welcome to the CHICKEN Scheme pasting service

debug-logging pasted by DerGuteMoritz on Fri Sep 23 12:02:41 2011

(module debug-logging

(current-debug-port debug-log-prefix debug)

(import chicken scheme)

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(import-for-syntax (only extras fprintf))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (display (debug-log-prefix) (current-debug-port))
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

)
[ permalink | raw ]

test.scm pasted by DerGuteMoritz on Fri Sep 23 12:03:47 2011

(module debug-test

(test)

(import chicken scheme)
(use debug-logging)

(define (test)
  (debug "hey")
  (print (* 10 10))
  (debug "yo"))

)

(import debug-test)
(test)
[ permalink | raw ]

csi vs. csc pasted by DerGuteMoritz on Fri Sep 23 12:07:41 2011

$ csi -D debug-logging-on -s test.scm 
[DEBUG] hey
100
[DEBUG] yo

$ csc -D debug-logging-on test.scm 
$ ./test

Error: unbound variable: fprintf
[ permalink | raw ]

working but unhygienic version pasted by DerGuteMoritz on Fri Sep 23 12:11:58 2011

(module debug-logging

(current-debug-port debug-log-prefix debug)

(import chicken scheme)

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (use (only extras fprintf))
       (display (debug-log-prefix) (current-debug-port))
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

)
[ permalink | raw ]

hygienic by means of gensym pasted by DerGuteMoritz on Fri Sep 23 12:20:05 2011

(module debug-logging

(current-debug-port debug-log-prefix debug)

(import chicken scheme)

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define-syntax debug
  (ir-macro-transformer
   (lambda (x i c)
     (let ((fprintf (gensym)))
       `(cond-expand
         (debug-logging-on
          (use (rename extras (fprintf ,fprintf)))
          (display (debug-log-prefix) (current-debug-port))
          (,fprintf (current-debug-port) . ,(cdr x))
          (newline (current-debug-port)))
         (else))))))

)
[ permalink | raw ]

FINAL STABLE HYGIENIC PRO 2011 pasted by DerGuteMoritz on Fri Sep 23 12:31:39 2011

(module debug-logging

(current-debug-port debug-log-prefix (debug fprintf display newline))

(import chicken scheme)
(use (only extras fprintf))

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (display (debug-log-prefix) (current-debug-port))
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

)
[ permalink | raw ]

FINAL STABLE HYGIENIC PRO 2011 PLUS pasted by DerGuteMoritz on Fri Sep 23 12:37:41 2011

(module debug-logging

(current-debug-port debug-log-prefix debug)

(import chicken scheme)
(use (only extras fprintf))

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (display (debug-log-prefix) (current-debug-port))
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

)
[ permalink | raw ]

debug* for increased delight pasted by DerGuteMoritz on Fri Sep 23 15:51:17 2011

(module debug-logging

(current-debug-port debug-log-prefix
 (debug display-prefix) (debug* display-prefix))

(import chicken scheme)
(use (only extras fprintf))

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define (display-prefix)
  (display (debug-log-prefix) (current-debug-port)))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (display-prefix)
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

(define-syntax debug*
  (syntax-rules ()
    ((_ args ... last)
     (cond-expand
      (debug-logging-on
       (begin
         (display-prefix)
         (pp args (current-debug-port))) ...
       (let ((last* last))
         (display-prefix)
         (pp last* (current-debug-port))
         last*))
      (else last)))))

)
[ permalink | raw ]

REALLY final debug-logging version? added by DerGuteMoritz on Fri Sep 23 15:57:52 2011

(module debug-logging

(current-debug-port debug-log-prefix debug debug*)

(import chicken scheme)
(use extras)

(define current-debug-port
  (make-parameter (current-output-port)))

(define debug-log-prefix
  (make-parameter "[DEBUG] "))

(define-syntax debug
  (syntax-rules ()
    ((_ fmt args ...)
     (cond-expand
      (debug-logging-on
       (display (debug-log-prefix) (current-debug-port))
       (fprintf (current-debug-port) fmt args ...)
       (newline (current-debug-port)))
      (else)))))

(define-syntax debug*
  (syntax-rules ()
    ((_ args ... last)
     (cond-expand
      (debug-logging-on
       (let ((last* last))
         (display (debug-log-prefix) (current-debug-port))
         (pp (list args ... last*) (current-debug-port))
         last*))
      (else last)))))

)
[ permalink | raw ]

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Given a list, which one-argument R5RS procedure returns the element at index 0?
Visually impaired? Let me spell it for you (wav file) download WAV