From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Leo Liu Newsgroups: gmane.emacs.bugs Subject: bug#18327: 24.4.50; [PATCH] vector QPattern for pcase Date: Fri, 05 Sep 2014 01:31:18 +0800 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1409853654 13177 80.91.229.3 (4 Sep 2014 18:00:54 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 4 Sep 2014 18:00:54 +0000 (UTC) Cc: 18327@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Sep 04 20:00:47 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XPbKw-0004In-5g for geb-bug-gnu-emacs@m.gmane.org; Thu, 04 Sep 2014 20:00:46 +0200 Original-Received: from localhost ([::1]:53293 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XPbKv-0006KZ-9C for geb-bug-gnu-emacs@m.gmane.org; Thu, 04 Sep 2014 14:00:45 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43191) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XPatG-0007qG-F1 for bug-gnu-emacs@gnu.org; Thu, 04 Sep 2014 13:32:18 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XPat8-0006U8-Q3 for bug-gnu-emacs@gnu.org; Thu, 04 Sep 2014 13:32:10 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:39189) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XPat8-0006U0-Mp for bug-gnu-emacs@gnu.org; Thu, 04 Sep 2014 13:32:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1XPat8-0007C1-9W for bug-gnu-emacs@gnu.org; Thu, 04 Sep 2014 13:32:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Leo Liu Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 04 Sep 2014 17:32:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 18327 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 18327-submit@debbugs.gnu.org id=B18327.140985190027620 (code B ref 18327); Thu, 04 Sep 2014 17:32:02 +0000 Original-Received: (at 18327) by debbugs.gnu.org; 4 Sep 2014 17:31:40 +0000 Original-Received: from localhost ([127.0.0.1]:58986 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XPasm-0007BP-6Z for submit@debbugs.gnu.org; Thu, 04 Sep 2014 13:31:40 -0400 Original-Received: from mail-pd0-f176.google.com ([209.85.192.176]:49942) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XPasg-0007B9-VT for 18327@debbugs.gnu.org; Thu, 04 Sep 2014 13:31:38 -0400 Original-Received: by mail-pd0-f176.google.com with SMTP id w10so4621203pde.7 for <18327@debbugs.gnu.org>; Thu, 04 Sep 2014 10:31:25 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:face:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=o+X+jqsmLS+TA0bq0DpDzTYXgt56Shg8XEs66/VSk+Y=; b=1B0IyIsnKtsDx+ZW1kkvNVW0TdtB4WJyzzEiv6P7PTwldn092bipRLYn3osqRqJ3Ul qvDnRA50Fp5GH08f4bUVzTvASF3WByi1OeZMndQIVr0LcuL++cTBDl89rRnpCZQU7+B1 xy3516K6ZVAgYBRsdoIyEXA5RgVFSxaiw7413K7LAflBBoyXf7akrpQverkQb3zUWz0H /kaRj6h6UkpCbB6av0IdBfzcJJzVfXFUlnjr+XVSSv4TAB2BXtTCYZ2oXiNuYAXgMf+H CkCYxF0ND8I6FYfdtxwzv0lk0b5k+hfKxIzgKCj925KSwYlY0Kv1lv1sAJQOSTRKT0zH 1EWQ== X-Received: by 10.66.245.34 with SMTP id xl2mr10974813pac.90.1409851884613; Thu, 04 Sep 2014 10:31:24 -0700 (PDT) Original-Received: from fortuna ([221.222.152.125]) by mx.google.com with ESMTPSA id ny7sm2226180pab.38.2014.09.04.10.31.22 for (version=TLSv1.1 cipher=RC4-SHA bits=128/128); Thu, 04 Sep 2014 10:31:23 -0700 (PDT) Face: iVBORw0KGgoAAAANSUhEUgAAACgAAAAoBAMAAAB+0KVeAAAAGFBMVEUzRVhbQj4eZqO6SjnT eWpxnMetm5b6/PmidmqrAAAAAWJLR0QAiAUdSAAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1F B9cBBwMLBfKABCMAAAFoSURBVCjPtZI9a8MwEIaFoc7aYDdelQMna0Em3tsSr0XUeE2Q6a22a+v+ fk8fSSBkbDUI6dHpfe9OEvRgiD+ApqKPJgJeB6iUUXWESjUe/ig38AJrhqqvaU2nTIXbNvOQ40fe qdry4kyGoVWsfCQalXpHnJGM01wjWdYbMlXNFdsZDO69m9aqNqxEJqTEgbM5OF7wlEfIoll1Ked4 LbM5X2EdILLokEdmI8z7g5cKED0cuTC930TYhy7ZDekkXVGw/L60TguJePPxcJF48lpsSUWEA/Ju jGFNgJOXc4Hz7TmAdBeu5Ve4AEjOi2/2jfd3cAJZ+IbNrvdjgBZY01b+HTuG3cLws6BJZqVOj/pp T0OqVwx3rFq+QmJwx3loK5JSLEhDIt62+mtC2C+SrAUxEbV6C6v2BRbd6pILBKFpepKZJHgGgrKF sptSUUoczpwg2pQ7ZH1tgs0ou/917mzz6Cs2//C978cv5l07L02orIEAAAAASUVORK5CYII= In-Reply-To: (Stefan Monnier's message of "Thu, 04 Sep 2014 12:21:59 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4.50 (CentOS 6.5) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:93032 Archived-At: --=-=-= Content-Type: text/plain On 2014-09-04 12:21 -0400, Stefan Monnier wrote: > Please double-check that it doesn't break bootstrap (CL uses pcase as > well, and I have some vague recollection of bumping into problems in > this area, which is why pcase doesn't use CL). Indeed, that failed to bootstrap. I get rid of cl-loop. > Also the patch needs to update pcase's docstring (based on my > understanding of your code, you only handle qpatterns of the form > [QPAT1..QPATn], right?). Yes, it only handles fixed-size vector qpatterns. Having built this simpler one your byte-code qpattern patch makes a lot more sense to me. And the `...' notation looks cool. For the packages I am writing fixed-size qpattern is more than enough ;) > Stefan Thanks, Leo --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=pcase-vector-qpat2.diff Content-Description: pcase-vector-qpat2.diff === modified file 'lisp/emacs-lisp/pcase.el' --- lisp/emacs-lisp/pcase.el 2014-01-03 04:40:30 +0000 +++ lisp/emacs-lisp/pcase.el 2014-09-04 17:16:34 +0000 @@ -108,11 +108,11 @@ \"non-linear\"), then the second occurrence is turned into an `eq'uality test. QPatterns can take the following forms: - (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. - ,UPAT matches if the UPattern UPAT matches. - STRING matches if the object is `equal' to STRING. - ATOM matches if the object is `eq' to ATOM. -QPatterns for vectors are not implemented yet. + (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. + [QPAT1 QPAT2] matches if QPAT1/2 match the first/second elements + ,UPAT matches if the UPattern UPAT matches. + STRING matches if the object is `equal' to STRING. + ATOM matches if the object is `eq' to ATOM. PRED can take the form FUNCTION in which case it gets called with one argument. @@ -447,6 +447,24 @@ (pcase--mutually-exclusive-p #'consp (cadr pat))) '(:pcase--fail . nil)))) +(defun pcase--split-vector (syms pat) + (cond + ;; A QPattern for a vector of same length + ((and (eq (car-safe pat) '\`) + (vectorp (cadr pat)) + (= (length syms) (length (cadr pat)))) + (let ((qpat (cadr pat))) + (cons `(and ,@(mapcar (lambda (s) + `(match ,(car s) . + ,(pcase--upat (aref qpat (cdr s))))) + syms)) + :pcase--fail))) + ;; Other QPatterns go to the `else' side. + ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) + ((and (eq (car-safe pat) 'pred) + (pcase--mutually-exclusive-p #'vectorp (cadr pat))) + '(:pcase--fail . nil)))) + (defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. @@ -738,8 +756,30 @@ ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN")) ((floatp qpat) (error "Floating point patterns not supported")) ((vectorp qpat) - ;; FIXME. - (error "Vector QPatterns not implemented yet")) + (let* ((len (length qpat)) + (syms (mapcar (lambda (i) (cons (make-symbol (format "xaref%s" i)) i)) + (number-sequence 0 (1- len)))) + (splitrest (pcase--split-rest + sym + (lambda (pat) (pcase--split-vector syms pat)) + rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest)) + (then-body (pcase--u1 + `(,@(mapcar (lambda (s) + `(match ,(car s) . + ,(pcase--upat (aref qpat (cdr s))))) + syms) + ,@matches) + code vars then-rest))) + (pcase--if + `(and (vectorp ,sym) (= (length ,sym) ,len)) + (macroexp-let* (delq nil (mapcar (lambda (s) + (and (get (car s) 'pcase-used) + `(,(car s) (aref ,sym ,(cdr s))))) + syms)) + then-body) + (pcase--u else-rest)))) ((consp qpat) (let* ((syma (make-symbol "xcar")) (symd (make-symbol "xcdr")) --=-=-=--