Hello<div><br></div><div>I wrote a matching pattern function and would like to share in order</div><div>to improve it (remove the compiler warnings for example, see below).</div><div><br></div><div>I started with the destruc function found in onLisp book by Paul Graham.</div>
<div><br></div><div>I modified the destruc function in order to not use the nth function (I found it</div><div>is not efficient); instead I bind partial results in generated symbols.</div><div><br></div><div>Also, unlike the dbind (see onLisp), the matching pattern function returns nil</div>
<div>if the structure is not matched otherwise it runs the given parameter body;</div><div>this allows us to check for alternative matches (used in compiler).</div><div><br></div><div>Any matching symbol x can be typed and must be of the form (:type x #'name)</div>
<div>where name is a boolean function with one argument (eg. numberp, consp, symbolp, </div><div>atom, ...)</div><div><br></div><div>Examples:</div><div><br></div><div>A pattern is a tree of symbols with possibly typed symbols</div>
<div><br></div><div><div>? (with-match-destruc (a (b (:type c #'symbolp))) (2 (3 4)) (list a b c))</div><div>;Compiler warnings :</div><div>; In an anonymous lambda form: Unused lexical variable #:G2554</div><div>; In an anonymous lambda form: Unused lexical variable #:G2555</div>
<div>NIL</div><div>? (with-match-destruc (a (b (:type c #'symbolp))) (2 (3 x)) (list a b c))</div><div>;Compiler warnings :</div><div>; In an anonymous lambda form: Unused lexical variable #:G2565</div><div>; In an anonymous lambda form: Unused lexical variable #:G2566</div>
<div>(2 3 X)</div><div><div>? (with-match-destruc (a (b c) (d (:type e #'symbolp)) f) (2 (3 4) (5 x) 6) (list a b c d e f))</div><div>;Compiler warnings :</div><div>; In an anonymous lambda form: Unused lexical variable #:G2598</div>
<div>; In an anonymous lambda form: Unused lexical variable #:G2601</div><div>; In an anonymous lambda form: Unused lexical variable #:G2604</div><div>(2 3 4 5 X 6)</div><div>? </div></div><div><br></div><div><br></div>
<div><br></div><div><div>(defmacro with-match-destruc (pat seq &body body)</div><div> (let ((x (gensym)))</div><div> `(block nil </div><div> (let* ((,x ',seq) </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> ,@(match-destruc pat x))</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>,@body)))))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span></div><div>(defun match-destruc (pat seq)</div><div> (cond</div><div> ((null pat) nil)</div>
<div> ((symbolp pat) `(,pat (if (symbolp ,seq) ,seq (return-from nil nil))))</div><div> ((atom pat)</div><div> (list `(,pat</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (if (atom ,seq) ,seq (return-from nil nil)))))</div>
<div> ((eq :type (car pat))</div><div> (list `(,(second pat)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (if (and (atom ,seq) (funcall ,(third pat) ,seq))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> ,seq (return-from nil nil)))))</div>
<div> (t</div><div> (let ((r </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (let* ((p (car pat))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (var (gensym))</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (rec (if (null (cdr pat))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> nil</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (cons `(,var (if (consp ,seq) (cdr ,seq)</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (return-from nil nil)))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (match-destruc (cdr pat) var)))))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (if (atom p)</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (cons `(,p (if (consp ,seq) (car ,seq)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (return-from nil nil))) rec)</div><div>
<span class="Apple-tab-span" style="white-space:pre"> </span> (if (eq (car p) :type)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (cons `(,(second p) </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (if (and (consp ,seq) (funcall ,(third p) (car ,seq)))</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (car ,seq) </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (return-from nil nil))) rec)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (append (match-destruc </div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> p </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> `(if (consp ,seq)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (car ,seq)</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (return-from nil nil)))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> rec))))))</div><div> (if (null (cdr pat))</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (cons `(,(gensym) ; dummy (should be declared to ignore)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> (if (not (and (consp ,seq) (null (cdr ,seq))))</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> (return-from nil nil)))</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> r)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> r)))))</div>
<div><br></div><div><br></div><div>Kind regards</div><div>Taoufik</div></div></div>