Commits

David Krentzlin committed d281b38

added hgignore

  • Participants
  • Parent commits 3d2cf6f

Comments (0)

Files changed (3)

+syntax: glob
+tests/*.log
+*.so
+*.import*
 ;; Description:
 ;; A logging library based on the ideas of CL's log5 http://common-lisp.net/project/log5
 ;;
-;; Author: David Krentzlin <david@lisp-unleashed.de>
-;; Maintainer: 
-;; Created: Di Dez  1 08:17:16 2009 (CET)
-;; Last-Updated: Di Dez 14 21:11:42 2010 (CET)
-;;           By: David Krentzlin
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 
 ;; Copyright (c) <2010> David Krentzlin <david@lisp-unleashed.de>
 ;; 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(module log5scm-lolevel
+(*default-logical-connective* *categories* *ignore-category-spec* expand-category-spec sender-matches-spec?)
+
+(import chicken scheme)
+(use extras data-structures ports srfi-1 srfi-69)
+
+;; 1) Categories
+;; Categories are just a way to organize your logmessages. You may
+;; arrange as many and as complex categories as you wish. They're,
+;; as the name suggests, a way to express buckets for
+;; log-messages. Those buckets may later be bound to senders and thus
+;; enable the program to put messages at the right places.
+(define (logical-connective? x)
+  (member x '(and not or)))
+
+;;by default all categories are or'ed together  
+(define *default-logical-connective* (make-parameter 'or))
+
+;;we need to store defined categories for late use
+;;NOTE: all categories inside this container are already expanded
+(define *categories* (make-parameter (make-hash-table)))
+
+(define (name->category name)
+  (hash-table-ref/default (*categories*) name #f))
+
+;; Find the category with the given name and expand it
+;; if needed
+(define (expand-category name)
+  (let ((spec (name->category name)))
+    (if spec  (if (list? spec) (expand-category-spec spec) spec) name)))
+
+;; Expansion is straight forward.
+;; Any occurence of a mere name is replaced by its expanded form.
+;; This is recursivly applied until the entire category is expanded
+;; Example:
+;; (define-category controller)
+;; (define-category model)
+;; (define-category app (or controller model))
+;; (define-category foo (not app (or app)))
+;;
+;; (expand-category-spec '(not app (or controller))) #=> (not (or controller model) (or controller))
+(define (expand-category-spec spec)
+  (cond
+   ((null? spec) '())
+   ((atom? spec) (expand-category spec))
+   ((list? spec)
+    `(,@(if (logical-connective? (car spec))
+            `(,(car spec) ,@(map expand-category-spec (cdr spec)))
+            `(,(*default-logical-connective*) ,@(map expand-category-spec spec)))))))
+
+(define (determine-variables spec)
+  (let ((positive '()) (negative '()))
+    (define (walk spec)
+      (cond
+       ((null? spec) #t)
+       ((atom? spec) (unless (logical-connective? spec)
+                       (set! positive (cons spec positive))))
+       ((eq? (car spec) 'not)
+        (set! negative (cons (cadr spec) negative)))
+       (else
+        (walk (car spec))
+        (walk (cdr spec)))))
+    (walk spec)
+    (values positive negative)))
+
+
+;;does the sender-spec match the cat-spec?
+;;sender and cat-spec should both be expanded
+(define (sender-matches-spec?  sender-spec cat-spec)
+  (receive (pos neg) (determine-variables cat-spec)
+    (and (category-spec-matches? pos sender-spec) (not (category-spec-matches? neg sender-spec )))))
+
+;;We determine if the current specification of the sender matches the
+;;category.
+;;We simply decide if we shall use this sender to send the message
+(define (category-spec-matches? cat spec) 
+  (define (bool-walk spec)
+    (cond
+     ((null? spec) #f)
+     ((atom? spec) (list? (member spec cat)))
+     ((list? spec)
+      (case (car spec)
+        ((or) (any identity (map bool-walk (cdr spec))))
+        ((and) (every identity (map bool-walk (cdr spec))))
+        ((not) (not (every identity (map bool-walk (cdr spec)))))
+        (else (map bool-walk spec))))))
+  (bool-walk spec))
+
+
+;; This variable can be set to a category spec that makes log-for
+;; calls expand into (void) when it matches.
+(define *ignore-category-spec*
+  (let ((spec (get-environment-variable "LOG5SCM_CAT_SPEC")))
+    (and spec (with-input-from-string spec read)))) 
+
+)
+
 (module log5scm
   (*default-logical-connective*
    *categories*
   (import (only data-structures identity atom?))
   (import (only srfi-13 string-join))
   (import (only srfi-1 any every))
+  (import log5scm-lolevel)
 
+;; Simple syntax to add categories to our categories-container
+;; It allows basically two forms: simple and complex
+;; Simple categories are just a symbol ( a name)
+;; Complex categories are logically connected categories
+(define-syntax define-category
+  (syntax-rules ()
+    ((_ name)
+     (hash-table-set! (*categories*) (quote name) (quote name)))
+    ((_ name (spec more-spec ...))
+     (hash-table-set! (*categories*) (quote name) (expand-category-spec (quote (spec more-spec ...)))))))
 
-  ;; 1) Categories
-  ;; Categories are just a way to organize your logmessages. You may
-  ;; arrange as many and as complex categories as you wish. They're,
-  ;; as the name suggests, a way to express buckets for
-  ;; log-messages. Those buckets may later be bound to senders and thus
-  ;; enable the program to put messages at the right places.
-  (define (logical-connective? x)
-    (member x '(and not or)))
-  
-  ;;by default all categories are or'ed together  
-  (define *default-logical-connective* (make-parameter 'or))
 
-  ;;we need to store defined categories for late use
-  ;;NOTE: all categories inside this container are already expanded
-  (define *categories* (make-parameter (make-hash-table)))
-
-  (define (name->category name)
-    (hash-table-ref/default (*categories*) name #f))
-  
-  ;; Find the category with the given name and expand it
-  ;; if needed
-  (define (expand-category name)
-    (let ((spec (name->category name)))
-      (if spec  (if (list? spec) (expand-category-spec spec) spec) name)))
-
-  ;; Expansion is straight forward.
-  ;; Any occurence of a mere name is replaced by its expanded form.
-  ;; This is recursivly applied until the entire category is expanded
-  ;; Example:
-  ;; (define-category controller)
-  ;; (define-category model)
-  ;; (define-category app (or controller model))
-  ;; (define-category foo (not app (or app)))
-  ;;
-  ;; (expand-category-spec '(not app (or controller))) #=> (not (or controller model) (or controller))
-  (define (expand-category-spec spec)
-    (cond
-     ((null? spec) '())
-     ((atom? spec) (expand-category spec))
-     ((list? spec)
-      `(,@(if (logical-connective? (car spec))
-              `(,(car spec) ,@(map expand-category-spec (cdr spec)))
-              `(,(*default-logical-connective*) ,@(map expand-category-spec spec)))))))
-  
-  ;; Simple syntax to add categories to our categories-container
-  ;; It allows basically two forms: simple and complex
-  ;; Simple categories are just a symbol ( a name)
-  ;; Complex categories are logically connected categories
-  (define-syntax define-category
-    (syntax-rules ()
-      ((_ name)
-       (hash-table-set! (*categories*) (quote name) (quote name)))
-      ((_ name (spec more-spec ...))
-       (hash-table-set! (*categories*) (quote name) (expand-category-spec (quote (spec more-spec ...)))))))
-  
-  ;;print a list of all currently defined categories to standard-output
-  (define (dump-categories)
-    (hash-table-map (*categories*) (lambda (k v) (sprintf "~A -> ~A" k v))))
-  
-
- (define (determine-variables spec)
-   (let ((positive '()) (negative '()))
-     (define (walk spec)
-       (cond
-        ((null? spec) #t)
-        ((atom? spec) (unless (logical-connective? spec)
-                        (set! positive (cons spec positive))))
-        ((eq? (car spec) 'not)
-         (set! negative (cons (cadr spec) negative)))
-        (else
-         (walk (car spec))
-         (walk (cdr spec)))))
-     (walk spec)
-     (values positive negative)))
-
-
- ;;does the sender-spec match the cat-spec?
- ;;sender and cat-spec should both be expanded
- (define (sender-matches-spec?  sender-spec cat-spec)
-   (receive (pos neg) (determine-variables cat-spec)
-     (and (category-spec-matches? pos sender-spec) (not (category-spec-matches? neg sender-spec )))))
-
- ;;We determine if the current specification of the sender matches the
- ;;category.
- ;;We simply decide if we shall use this sender to send the message
- (define (category-spec-matches? cat spec) 
-   (define (bool-walk spec)
-     (cond
-      ((null? spec) #f)
-      ((atom? spec) (list? (member spec cat)))
-      ((list? spec)
-       (case (car spec)
-         ((or) (any identity (map bool-walk (cdr spec))))
-         ((and) (every identity (map bool-walk (cdr spec))))
-         ((not) (not (every identity (map bool-walk (cdr spec)))))
-         (else (map bool-walk spec))))))
-   (bool-walk spec))
+;;print a list of all currently defined categories to standard-output
+(define (dump-categories)
+  (hash-table-map (*categories*) (lambda (k v) (sprintf "~A -> ~A" k v))))
 
 
  ;; 2) Senders
           ((sender-handler sender)
            (string-join outputs " ")))) category-spec)))
 
+ (import-for-syntax log5scm-lolevel)
+
  ;; Finally we can define our logging macro
  (define-syntax log-for
-   (syntax-rules ()
-     ((_ (extended more ...) fmt args ...)
-      (find-and-apply-senders (quote (extended more ...)) fmt args ...))
-     ((_ simple-spec fmt args ...)
-      (find-and-apply-senders (quote (simple-spec)) fmt args ...))))
-
+   (ir-macro-transformer
+    (lambda (expression inject compare)
+      (let* ((spec (second expression))
+             (spec (if (list? spec) spec (list spec))))
+        (if (or (not *ignore-category-spec*)
+                (sender-matches-spec? *ignore-category-spec* (expand-category-spec (strip-syntax spec))))
+            `(find-and-apply-senders ',spec . ,(cddr expression))
+            '(void))))))
  )

File log5scm.setup

-(compile -s -d0 -O3 log5scm.scm -j log5scm)
+(compile -s -d0 -O3 log5scm.scm -j log5scm -j log5scm-lolevel)
 (compile -s -d0 -O3 log5scm.import.scm)
+(compile -s -d0 -O3 log5scm-lolevel.import.scm)
 
 (install-extension
   'log5scm
-  '("log5scm.import.so" "log5scm.so")
+  '("log5scm.so" "log5scm.import.so" "log5scm-lolevel.import.so")
   '((version 0.3)))