[Logs-devel] rule macro attempt #1

[Vijay Lakshminarayanan]

Hi Jim

Here's a very poor first attempt at making a macro to define rules
easily.  I don't have ideas for how to include environment, continue,
kill-rule-after-usage etc.  There are currently four clauses accepted
(and that too not too well) and :actions aren't allowed, but I think
it isn't too bad as an idea (can't say the same about the program).

;;; Influenced by Peter Norvig's LOOP implementation

(defstruct rool
 (name '())
 (match '())
 (timeout '()) (relative-timeout '())
 (delete-rule '()) (continuep '())
 (actions '()))

(defmacro rule (&rest exprs)
 (let ((r (make-rool)))
   (parse-rule r exprs)
   (fill-rule-template r)))

(defun fill-rule-template (rool)
 `(make-instance
   'logs::rule
   ,@(loop as (key fn) in '((:match rool-match)
                            (:name rool-name)
                            (:timeout rool-timeout)
                            (:relative-timeout rool-relative-timeout)
                            (:actions rool-actions))
           as res = (funcall fn rool)
           if res append `(,key ,res))))

(defun parse-rule (rool exprs)
 (unless (null exprs)
   (parse-rule rool (parse-keyword rool (car exprs) (cdr exprs)))))

(defun parse-keyword (rool keyword exprs)
 (if (get keyword 'handle-fn)
     (funcall (get keyword 'handle-fn) rool exprs)
     (error "Unknown keyword ~S" keyword)))

(defun handle-name (rool exprs)
 (destructuring-bind (name . cdr) exprs
   (if (and (symbolp name)
            (null (rool-name rool)))
       (setf (rool-name rool) `',name)
       (error "Invalid name ~S" name))
   cdr))

(defun handle-match (rool exprs)
 (let ((matches (rool-match rool)))
   ;; For now, we ignore.  Later we add or something
   (declare (ignore matches))
   (destructuring-bind (car . cdr) exprs
     (case car
       (regexp (let ((msg (gensym "MESSAGE"))
                     (regex (pop cdr)))
                 (setf (rool-match rool)
                       `(lambda (,msg)
                         (cl-ppcre:scan-to-strings ,regex ,msg)))
                 cdr))
       (message-length (let ((msg (gensym "MESSAGE"))
                             (relop (pop cdr))
                             (num (pop cdr)))
                         (setf (rool-match rool)
                               `(lambda (,msg)
                                 (,relop (length (message ,msg)) ,num)))
                         cdr))
       (t (setf (rool-match rool) car) cdr)))))

(defun handle-timeout (rool exprs)
 (destructuring-bind (preposition . (time . cdr)) exprs
   (case preposition
     (in (setf (rool-relative-timeout rool) time))
     (at (setf (rool-timeout rool) time)))
   cdr))

(setf (get 'match 'handle-fn) #'handle-match)
(setf (get 'name 'handle-fn) #'handle-name)
(setf (get 'timeout 'handle-fn) #'handle-timeout)

;;;;; =========

Here are some examples with their expansions:

CL-USER> (macroexpand '(rule match regexp "a.*b"))
(MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
              :MATCH
              (LAMBDA (#:MESSAGE1939)
                (CL-PPCRE:SCAN-TO-STRINGS "a.*b" #:MESSAGE1939)))
T
CL-USER> (macroexpand '(rule name 'simple-1 match regexp "a.*b"))
(MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
              :MATCH
              (LAMBDA (#:MESSAGE1940)
                (CL-PPCRE:SCAN-TO-STRINGS "a.*b" #:MESSAGE1940))
              :NAME
              'SIMPLE-1)
T
CL-USER> (macroexpand '(rule name 'simple-1
                            match message-length <= 80))
(MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
              :MATCH
              (LAMBDA (#:MESSAGE1941)
                (<= (LENGTH (MESSAGE #:MESSAGE1941)) 80))
              :NAME
              'SIMPLE-1)
T
CL-USER> (macroexpand '(rule name 'simple-1
                            match #'match-all))
(MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE :MATCH #'MATCH-ALL :NAME 'SIMPLE-1)
T
CL-USER> (macroexpand '(rule name 'simple-1 timeout in (+ 4 8)))
(MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
              :NAME
              'SIMPLE-1
              :RELATIVE-TIMEOUT
              (+ 4 8))
T
CL-USER> (macroexpand '(rule name 'simple-1 timeout at 85933))
(MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE :NAME 'SIMPLE-1 :TIMEOUT 85933)
T

Please give me your thoughts.  In which time hopefully I'll get a
better implementation idea :)

Thanks
Vijay