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>