[Openmcl-devel] matching patterns

[Taoufik Dachraoui]

Hi

I wrote a matching pattern (recursive) function and would like to share it;
it is still work in progress (some bugs are expected to show up anytime)


I started with the destruc function found in onLisp book by Paul Graham.



The following is a draft of a poor doc and some examples of usage:

; variables: untyped :x, typed (:var x (integer 0 9))



keywords :var :all :lone, :some, :not, :or, :and, :type, :match, this



pattern == _ | (:all pattern) | (:lone pattern) | (:not pattern)

             | (:some pattern pattern) | (:var var pattern) | keyword

             | (:or pattern pattern) | (:type primitive-pattern)

             | literal | ( pattern* ) | this | (:match pattern)

     where _ matches anything (any lisp element)

     this is a recursive reference to the current matching pattern

     :match starts a new matching pattern for the current element

     keyword is a variable (ie. :x is equivalent to (:var x _))

  primitive-pattern == lisp types (eg. integer, number, consp, ...)

  literal == lisp atoms (number, string, symbol, ...)



       :x == (:var x _)

       _ == (:type t)

       (pattern1 (:lone pattern2) pattern3) == (:or (pattern1 pattern2
pattern3) (pattern1 pattern3))
       (:some pattern (:type null)) == (:all pattern)

       (match '(1 2 3 . 4) ((:all (:type integer)) 'ok)) -> NIL   fails
because of the dotted list
               :all matches a sequence (:some can match any list as shown
below)
       (match '(1 2 3 . 4) ((:some (:type integer) (:var x (:type
integer))) x)) -> 4
       (match '(1 2 A . 4) ((:some (:type integer) (:var x _)) x)) -> (X .
4)
       (match '(a b c) (('a (:lone 'b) 'c) 'ok))          -> OK

       (match '(a c) (('a (:lone 'b) 'c) 'ok))          -> OK

       (match 3 ((:not (:type integer)) 'ok)) ; match a non integer

         -> NIL

       (:not (_ . _)) == (:not (:type consp)) ; match an atom

       (match '(1 2 3 4) ((:all (:type integer)) 'ok))           -> OK

       (match '((a 1) (b foo) (c ok)) ((:all (:var val ((:var key (:type
symbol)) _))) (list val key)))
          -> ((C OK) C)

       (match '((a 1) (b 2) (c 3)) ((:all ((:var x (:type symbol)) (:var y
(:type integer)))) (list x y)))
         -> (C 3)

       ? (match '(1 (2 2 2) 3) ((:x (:var y (:match (:or (:type null) (2 .
this)))) :z) (values x y z)))
1

(2 2 2)

3

****  (:some _) is problematic (implement rollback?)

      currently we have (:some _) == (:all _)

      *** in general in ((:some p1) p2), p1 and p2 must be incompatible

          that is if x is matched by p2 then x must not be matched by p1



? (defun member? (x e) (match e ((:or (:var r (x . _)) (_ . this)) r)))

MEMBER?

? (member? 'x '(a b x c))

(X C)

? (member? 'x '(a b c))

NIL

? (member? '(1 2) '(a (1 2) b))
((1 2) B)


20120729: TODO convert a regular expression to a pattern

    "a*" -> (:lone ((:all #\a)))

    "a*b" -> ((:lone (:some #\a)) #\b)

  many difficulties are to expect (eg. ".*H" -> ((:some _) #\H)

    some consumes all characters and the match fail because of end of
inputs and we still have #\H to read


I am currently using the match macro to implement a simple lambda calculs
interpreter (normal order, lazy, untyped)

For example the full beta reduction is as follows:

(defun fv? (e u)
  "(member u (fv e))"
  (match e
         ((:var v (:type atom))
          (eq u v))
         (('fn :v :e0)
          (and (not (eq u v)) (fv? e0 u)))
         ((:e0 :e1)
          (or (fv? e0 u) (fv? e1 u)))
         (_ (error "fv?: invalid syntax"))))

(defun br  (eb v ea &optional (i 0))
  "beta-reduction (in-place version)"
  (format t "~Abr: ~S ~S ~S~%" (%cars i) eb v ea)
  (let ((r
  (match eb
         (v ea)
         ((:or (:type atom) ('fn v _)) eb)
         (('fn :u :e0)
          (if (not (and (fv? ea u) (fv? eb v)))
              (progn
                (setf (third eb) (br e0 v ea (1+ i)))
                eb)
              (let ((w (gensym)))
                (setf (third eb) (br (br e0 u w (1+ i)) v ea (1+ i)))
                (setf (second eb) w)
                eb)))
         ((:e0 :e1)
          (setf (first eb) (br e0 v ea (1+ i)))
          (setf (second eb) (br e1 v ea (1+ i)))
          eb)
         (_ (error "br: invalid syntax")))))
    (format t "~Arbr r:~A~%" (%cars i) r)
    r))


Kind regards
Taoufik
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20121003/86ea03a0/attachment.htm>