scheme optimizations found in syslog-ng

[thi]

i was (am still in the process of) looking at syslog-ng source, and
stumbled on subdir libol-0.2.16, which appears to be a system for
generating class definitions/interfaces (for C) from C-embedded schemey
description comments, for example:

   /* CLASS:
      (class
        (name read_line)
        (super read_handler)
        (vars
          (handler object line_handler)
   
          ; Line buffer       
          (pos simple UINT32)
          (buffer array UINT8 MAX_LINE)))
   */

in read_line.c produces in read_line.c.x (which is included back into
read_line.c):

   #ifndef CLASS_DEFINE
   struct read_line
   {
     struct read_handler super;
     struct line_handler *handler;
     UINT32 pos;
     UINT8 ((buffer)[MAX_LINE]);
   };
   extern struct ol_class read_line_class;
   #endif /* !CLASS_DEFINE */
   
   #ifndef CLASS_DECLARE
   static void do_read_line_mark(struct ol_object *o, 
   void (*mark)(struct ol_object *o))
   {
     struct read_line *i = (struct read_line *) o;
     mark((struct ol_object *) i->handler);
   }
   
   struct ol_class read_line_class =
   { STATIC_HEADER,
     &read_handler_class, "read_line", sizeof(struct read_line),
     do_read_line_mark,
     NULL
   };
   #endif /* !CLASS_DECLARE */

ho hum.  this was not so remarkable, but the following condensed frag
from the preprocessor scsh script libol-0.2.16/utils/make_class.in
caught my eye:

   ;; Some mor patterns that can ba useful for optimization. From "A
   ;; combinator-based compiler for a functional language" by Hudak &
   ;; Kranz.
   
   ;; S K => K I
   ;; S (K I) => I
   ;; S (K (K x)) => K (K x)
   ;; S (K x) I => x
   ;; S (K x) (K y) => K (x y)
   ;; S f g x = f x (g x)
   ;; K x y => x
   ;; I x => x
   ;; Y (K x) => x
   
   (define optimizations
     (list (rule '(S (K *) (K *)) (lambda (p q) (make-K (make-appliction p q))))
        (rule '(S (K *) I) (lambda (p) p))
        ;; (rule '(B K I) (lambda () 'K))
        (rule '(S (K *) (B * *)) (lambda (p q r) (make-combine 'B* p q r)))
        (rule '(S (K *) *) (lambda (p q) (make-combine 'B p q)))
        (rule '(S (B * *) (K *))  (lambda (p q r) (make-combine 'C* p q r)))
        ;; (rule '(C (B * *) *) (lambda (p q r) (make-combine 'C* p q r)))
        (rule '(S * (K *)) (lambda (p q) (make-combine 'C p q)))
        (rule '(S (B * * ) r) (lambda (p q r) (make-combine 'S* p q r)))))
   
   (define (optimize expr)
     ;; (werror "optimize ~S\n" expr)
     (let loop ((rules optimizations))
       ;; (if (not (null? rules)) (werror "trying pattern ~S\n" (caar rules)) )
       (cond ((null? rules) expr)
          ((match (caar rules) expr)
           => (lambda (parts) (apply (cdar rules) parts)))
          (else (loop (cdr rules))))))
   
   (define (optimize-application op args) ...)
   (define (make-combine op . args) ...)
   (define (translate-expression expr) ...)
   (define (translate-lambda v expr) ...)
   (define (make-flat-application op arg) ...)
   (define (flatten-application expr) ...)
   (define (translate expr) ...)

i'm wondering if some of these optimizations might be useful for
guile-comp (or the hobbit rehash, as it seems to be working out).
in any case, for more info, do "apt-get source syslog-ng" or check
out the syslog-ng homepage:

   http://www.balabit.hu/products/syslog-ng/

thi