Re: [Logs-devel] rule macro attempt #1

[Jim Prewett]

Hi Vijay

I've only had a few moments to look this over.  So far, it looks pretty 
good!

I've changed HANDLE-NAME to:

(defun handle-name (rool exprs)
  (destructuring-bind (name . cdr) exprs
    ;; rule names don't have to be symbols
    ;; symbols are (obviously) a pretty good idea, but 
    ;; strings, etc. should work as well
    (if (null (rool-name rool))
        (setf (rool-name rool) `',name)
        (error "Invalid name ~S" name))
    cdr))

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
> 
> 
> _______________________________________________
> LoGS-devel mailing list
> address@hidden
> http://lists.nongnu.org/mailman/listinfo/logs-devel
>