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

[Jim Prewett]

> I have made one or two more changes.  I was shooting myself in the
> foot trying to use cl-yacc.  I'm sure it's a great tool but I couldn't
> get the hang of it to parse LoGS rules.  anyway, you were right about
> it being a large hammer.  I think we can do without it.

That advice came from a colleague of mine, Roy Hiembach.  His job is 
mostly to help our users with their programming isssues; for the most 
part, he gives really good advice :)  He convinced me that any form of 
parser-generator would likely be overkill

> I've extended set-env to accept a LOOP like AND syntax:
> 
> (rule with foo = "one" and bar = "two" do (lambda (x) (list foo bar)))

cool!  I like it!

> I have a few more questions.  I'll ask them in the morning.  I've
> added a keyword FILTER and have a question there.

I'll look at this later today.

Jim

> 
> Thanks Jim!
> 
> ;;; Paul Graham, On Lisp, p191
> (defmacro aif (test-form then-form &optional else-form)
>  `(let ((it ,test-form))
>    (if it ,then-form ,else-form)))
> 
> ;;; an 'accessor' for the handle-fns
> (defmacro handle-fn (keyword)
>  `(get ,keyword 'handle-fn))
> 
> (defmacro alias (keyword)
>  `(get ,keyword 'alias))
> 
> ;;; Influenced by Peter Norvig's LOOP implementation
> (defstruct rool
>  (name '())
>  (match '())
>  (timeout '())
>  (relative-timeout '())
>  (delete-rule '())
>  (continuep '())
>  (actions '())
>  (environment '())
>  (delete '()))
> 
> (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
>    :environment ',(rool-environment rool)
>    ,@(loop as (key fn) in '((:match rool-match)
>                             (:name rool-name)
>                             (:timeout rool-timeout)
>                             (:continuep rool-continuep)
>                             (: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)
>  (let* ((keyword (or (alias keyword) keyword)))
>    (aif (handle-fn keyword)
>         (funcall it rool exprs)
>         (error "Unknown keyword ~S" keyword))))
> 
> (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))
> 
> (defun handle-match (rool exprs)
>  (let ((matches (rool-match rool)))
>    ;; For now, we ignore.  Later we add
>    ;; facilities to add other messages
>    (declare (ignore matches))
>    (destructuring-bind (car . cdr) exprs
>      (case car
>        (regexp (let ((msg (gensym "MESSAGE"))
>                      (matches (gensym))
>                      (sub-matches (gensym))
>                      (regex (pop cdr)))
>                  (setf (rool-match rool)
>                        `(lambda (,msg)
>                          (multiple-value-bind (,matches ,sub-matches)
>                              (cl-ppcre:scan-to-strings
>                               ,regex
>                               (logs::message ,msg))
>                            (when ,matches
>                              (values t
>                                      '((sub-matches ,sub-matches)))))))
>                  cdr))
>        (message-length (let ((msg (gensym "MESSAGE"))
>                              (relop (pop cdr))
>                              (num (pop cdr)))
>                          (setf (rool-match rool)
>                                `(lambda (,msg)
>                                  (,relop (length (logs::message
>                                                   ,msg)) ,num)))
>                          cdr))
>        (t (setf (rool-match rool) car) cdr)))))
> 
> (defun handle-filter (rool exprs)
>  (destructuring-bind (regexp regex . cdr) exprs
>    (let ((exprs (handle-match rool exprs)))
>      (setf (rool-continuep rool) t
>            ;; There has to be some way to set the
>            ;; whole to just NIL.
>            ;; I see the following possibilities:
>            ;; we parse EXPRS and remove all
>            ;; action clauses.
>            ;; We change the design of LoGS such
>            ;; that actions is actually (by
>            ;; default) (block NIL (list action-1
>            ;; action-2)) and then we just do a
>            ;; (setf (rool-actions rool) '(return))
>            (rool-actions rool) nil))))
> 
> (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))
> 
> (defun handle-setenv (rool exprs)
>  (destructuring-bind (variable = value &rest rest) exprs
>    (declare (ignore =))
>    (pushnew (list variable value)
>             (rool-environment rool)
>             :test
>             (lambda (x y) (equal (car x) (car y))))
>    (if (eq (car rest) 'and)
>        ;; More than one variable has been
>        ;; defined.  Save that too.
>        (handle-setenv rool (cdr rest))
>        rest)))
> 
> ;; add the given function to the actions list
> (defun handle-do (rool exprs)
>  (destructuring-bind (todo &rest rest) exprs
>    (format t "rool: ~A~%todo: ~A~%rest: ~A~%~
>               rool-actions:~S~%~50~~%"
>            rool todo rest (rool-actions rool))
>    (setf (rool-actions rool) (append (rool-actions rool) (list (eval todo))))
>    rest))
> 
> ;; set the continue slot to t
> (defun handle-continue (rool exprs)
>  (setf (rool-continuep rool) t)
>  exprs)
> 
> ;; set the delete slot to t
> (defun handle-delete (rool exprs)
>  (setf (rool-delete rool) t)
>  exprs)
> 
> ;;; Set aliases for keywords so we have synonyms
> ;;; and define the handler function
> (defmacro defhandler (keywords alias handle-fn)
>  `(setf ,@(if (consp keywords)
>               (loop as keyword in keywords
>                     appending `((alias ',keyword) ',alias))
>               `((alias ',keywords) ',alias))
>         (handle-fn ',alias) ,handle-fn))
> 
> (defhandler (match matching) :match #'handle-match)
> (defhandler (name named) :name #'handle-name)
> (defhandler (do doing) :do #'handle-do)
> (defhandler continue :continue #'handle-continue)
> (defhandler timeout :timeout #'handle-timeout)
> (defhandler (set-env with) :set-env #'handle-setenv)
> (defhandler delete :delete #'handle-delete)
> 
> ;;; *eof*
> 
> 
> On 6/4/06, Jim Prewett <address@hidden> wrote:
> > 
> > Hi Vijay,
> > 
> > I've had fun playing with your code today (unfortunately, some yard work,
> > etc. kept me busy for too much of it :).  I've made a few minor
> > modifications, and generally think your code has a nice feel to it :)
> > kudos!
> > 
> > Here is an example using some of the new things I've added:
> > 
> > (rule
> >         name 'foo
> >         match regexp ".+"
> >         ;; set variable var1 to 42
> >         setenv var1 = 42
> >         ;; first action
> >         doing (lambda (x) (format t "message: ~A var1: ~A~%" (message x)
> > var1))
> >         ;; second action
> >         doing #'print-message
> >         ;; set continuep slot to t
> >         continue)
> > 
> > ;;; Paul Graham, On Lisp, p191
> > (defmacro aif (test-form then-form &optional else-form)
> >   `(let ((it ,test-form))
> >     (if it ,then-form ,else-form)))
> > 
> > ;;; an 'accessor' for the handle-fns
> > (defmacro handle-fn (keyword)
> >   `(get ,keyword 'handle-fn))
> > 
> > ;;; Influenced by Peter Norvig's LOOP implementation
> > 
> > (defstruct rool
> >   (name '())
> >   (match '())
> >   (timeout '())
> >   (relative-timeout '())
> >   (delete-rule '())
> >   (continuep '())
> >   (actions '())
> >   (environment '()))
> > 
> > (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
> >     :environment ',(rool-environment rool)
> >     :actions (rool-actions ,rool)
> >     ,@(loop as (key fn) in '((:match rool-match)
> >                              (:name rool-name)
> >                              (:timeout rool-timeout)
> >                              (:continuep rool-continuep)
> >                              (:relative-timeout rool-relative-timeout))
> >             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)
> >   (aif (handle-fn keyword)
> >        (funcall it rool exprs)
> >        (error "Unknown keyword ~S" keyword)))
> > 
> > (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))
> > 
> > (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"))
> >                       (matches (gensym))
> >                       (sub-matches (gensym))
> >                       (regex (pop cdr)))
> >                   (setf (rool-match rool)
> >                         `(lambda (,msg)
> >                           (multiple-value-bind (,matches ,sub-matches)
> >                               (cl-ppcre:scan-to-strings ,regex (message
> > ,msg))
> >                             (when ,matches
> >                               (values t
> >                                       '((sub-matches ,sub-matches)))))))
> >                   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))
> > 
> > (defun handle-setenv (rool exprs)
> >   (destructuring-bind (variable equal value &rest rest) exprs
> >     (pushnew (list variable value)
> >              (rool-environment rool)
> >              :test
> >               (lambda (x y) (equal (car x) (car y))))
> >     rest))
> > 
> > ;; add the given function to the actions list
> > (defun handle-do (rool exprs)
> >   (destructuring-bind (todo &rest rest) exprs
> >     (format t "rool: ~A todo: ~A rest: ~A~%"
> >             rool todo rest)
> >     (append (rool-actions rool) (list (eval todo)))
> >     rest))
> > 
> > ;; set the continue slot to t
> > (defun handle-continue (rool exprs)
> >   (setf (rool-continuep rool) t)
> >   exprs)
> > 
> > (setf (handle-fn 'match) #'handle-match)
> > (setf (handle-fn 'name) #'handle-name)
> > (setf (handle-fn 'timeout) #'handle-timeout)
> > 
> > ;; new
> > (setf (handle-fn 'continue) #'handle-continue)
> > (setf (handle-fn 'setenv) #'handle-setenv)
> > (setf (handle-fn 'doing) #'handle-do)
> > 
> > 
> > Jim
> > 
> > James E. Prewett                    address@hidden address@hidden
> > Systems Team Leader           LoGS: http://www.hpc.unm.edu/~download/LoGS/
> > Designated Security Officer         OpenPGP key: pub 1024D/31816D93
> > HPC Systems Engineer III   UNM HPC  505.277.8210
> > 
> > On Sun, 4 Jun 2006, Vijay Lakshminarayanan wrote:
> > 
> > > On 6/4/06, Jim Prewett <address@hidden> wrote:
> > > > > > I was wondering how you're envisioning this working for rules that
> > > > create
> > > > > > rules ... that create rules?
> > > > > >
> > > > > > (make-instance 'rule
> > > > > >         :actions
> > > > > >         (list
> > > > > >           (lambda (message)
> > > > > >              (enqueue *root-ruleset* (make-instance 'rule ...)))))
> > > > >
> > > > > We just use the macro again, I guess.
> > > > >
> > > > > (rule performing (lambda (message) (enqueue *root-ruleset* (rule
> > > > ...))))
> > > > >
> > > >
> > > > I was hoping that was the answer :)
> > >
> > > Oh so it's a Good Thing?  That's a relief :-)
> > >
> > > > > In time we should have a single function which does the enqueing.
> > > >
> > > > I don't think you're quite understanding the ruleset tree structure.
> > > > rulesets contain rules and other rulesets.  You may want to have a rule
> > > > that creates a new rule on a completely different part of the tree.
> > >
> > > You're right.  I completely forgot about this -- I was totally
> > > immersed into defining the macro's behavior itself.
> > >
> > > > In other words, I don't see specifying the ruleset you're adding the
> > rule
> > > > to to be a loss.
> > > >
> > > > Jim
> > > >
> > >
> > > Will come up with more and better quality code soon, Jim.
> > >
> > > Thanks
> > > Vijay
> > >
> > 
>