From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Tim Van den Langenbergh Newsgroups: gmane.lisp.guile.user Subject: Re: Syntax-Case macro that selects the N-th element from a list Date: Mon, 05 Apr 2021 15:51:27 +0200 Message-ID: <3445000.C9EYdkiGp3@terra> References: <87im5155pu.fsf@web.de> Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="10543"; mail-complaints-to="usenet@ciao.gmane.io" Cc: guile-user To: "Dr. Arne Babenhauserheide" Original-X-From: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Mon Apr 05 15:57:36 2021 Return-path: Envelope-to: guile-user@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1lTPjS-0002Yp-F6 for guile-user@m.gmane-mx.org; Mon, 05 Apr 2021 15:57:34 +0200 Original-Received: from localhost ([::1]:54854 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lTPjR-0003bU-ER for guile-user@m.gmane-mx.org; Mon, 05 Apr 2021 09:57:33 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:55310) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lTPiY-0003ax-Dw for guile-user@gnu.org; Mon, 05 Apr 2021 09:56:39 -0400 Original-Received: from mout.gmx.net ([212.227.17.22]:54347) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lTPiT-0005MZ-Uu for guile-user@gnu.org; Mon, 05 Apr 2021 09:56:38 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1617630990; bh=vX4udyxOS8aa/tO3mze9/vzO+IlEaNkxl2hAaKlSPPE=; h=X-UI-Sender-Class:From:To:Cc:Subject:Date:In-Reply-To:References; b=P0uXrHJ4Xw+VC/wDeyiYDoztsfd00nqvUiGuYebnuNxwaY1kaQ5yH3tp343tMdCzX sjf27JDSobHe7h8Gsd5Y4tKeGApzWvVNaSdLvV6nF0PemWZGrDQFSAkVewEyO7zjjn FqyMPVuHc1YS7lrfv0n0AGqGmdMo5lD2hOTGN+vw= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Original-Received: from terra.localnet ([94.227.125.226]) by mail.gmx.net (mrgmx104 [212.227.17.174]) with ESMTPSA (Nemesis) id 1MGQnF-1lNesH46DV-00GqRT; Mon, 05 Apr 2021 15:51:29 +0200 In-Reply-To: <87im5155pu.fsf@web.de> X-Provags-ID: V03:K1:zzRbDGIaaHbidT5a3YshmJQ+WHAcAt05py96wf9nP7Da47zoToY MiyBwLRwf9jS/X7Vg6ETgpD2ae0o0YhqPDR0dj0LuyQ7o4ZRD0G5tAwQISvI+l0D3VfECBL V1gx/zrvWdCM9Nt1eLJ9hdxl6+kklgjpc8cZmIQDyGymhtQ5oeFkqlEVcDLVK+if/ZI3qGr EYF3jfgc3Ow9ntJmI9fug== X-UI-Out-Filterresults: notjunk:1;V03:K0:I0VeCPq0nLo=:1k9J44kXFirUrBvjpafBaD 3/RjAf/r3m0VLk/JTohwTOfBhbGq8cnkXc8Ikq5FLtOXO24jZ1+EPP/aTRfiW3CwoHHkyJrov TLFBfGMjxiG5RxZ5g0k+zQ4eWHrw8GSfJsrka0XC4bYhBO78b4dexRVeEldaJeMJ7VbkojE7j 2lxLUHQoVFtJ2M79lrlvSp7aEKEh2Nfc25jaE+roTbeR4OvTcmFZ1JqsTRdSJmwaG9gs59522 XDnYZ0NuCx62/xXe5jc9ZgqLSvK9rGsyQk6TJLdxpiswzFaQsf97Pz8toOungMso92is8EX6o Ih4/ZkvYpysrurehiR9MEqk/TLSiTxzj+3OWbgEcVPNF8PpzgKSvv/9osg7BS8UeTxabbRiUK +OBZil/FSDgV71VGveunoUsJzXujno6AcVe0N0Zx+zQPWrC9whvDckv801IVIP/zEFcPfYRoL eMLeHVL5tYUj+yMfwHOKYQQedDdPrkAy6ptEbHIoDQQVkgc+elFHAobGa1dPoYeXB49Vg/VC0 abJ1eqQJmDBKNfQ4gjbI20ZF1U79vzOfya/QVEfqMPtuSR8FRTrxyRCxrvXZ5WhPVS81IuuVq igKvAzghWbsTlfYUgyOWQKolAeXv184K5ICrjP74XWUjX2v4iZD9jFsuQsJw3I060bvG959jB 6CslSQL/yBTp/NXtFZgA1h+Ydn6erMlHEokNzXUzdSKRlP3sMDK3aDsJCHK5EVWFKIhnU4aO0 LAH4JJqS6KQeds+yS7PZlZoxeVbPMFQiB+R2B4tNFE8FiThnjivOPOoHz/WUTtt+JumHln+q Received-SPF: pass client-ip=212.227.17.22; envelope-from=tmt_vdl@gmx.com; helo=mout.gmx.net X-Spam_score_int: -25 X-Spam_score: -2.6 X-Spam_bar: -- X-Spam_report: (-2.6 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.io gmane.lisp.guile.user:17394 Archived-At: On Monday, 5 April 2021 13:30:21 CEST you wrote: > Hi, >=20 > In dryads-wake I need selection of the element in a list in a macro from > user-input. Currently I have multiple macros, and the correct one (which > strips the non-selected choices) is selected in a simple cond: >=20 > (define-syntax-rule (Choose resp . choices) > "Ask questions, apply consequences" > (cond > ((equal? resp 1) ;; resp is user-input. It is a natural number. > (Respond1 choices)) > ((equal? resp 2) > (Respond2 choices)) > ((equal? resp 3) > (Respond3 choices)) > (else > #f))) >=20 > For this however I have three syntax-case macros: >=20 > (define-syntax Respond1 > (lambda (x) > (syntax-case x () > ((_ ((question consequences ...) choices ...)) > #`(begin > (respond consequences ...))) > ((_ (choices ...)) > #`(begin #f))))) >=20 > (define-syntax Respond2 > (lambda (x) > (syntax-case x () > ((_ (choice choices ...)) > #`(begin > (Respond1 (choices ...)))) > ((_ (choices ...)) > #`(begin #f))))) >=20 > (define-syntax Respond3 > (lambda (x) > (syntax-case x () > ((_ (a b choices ...)) > #`(Respond1 (choices ...))) > ((_ (choices ...)) > #`(begin #f))))) >=20 >=20 > I would like to get rid of those three definitions and replace them by > at most two (one that strips N initial list entries, and Respond1). >=20 > I cannot move to procedures, because I have code that must be executed > only during final processing, and when I evaluate any of the > consequences (as it happens with procedure-arguments), then the timing > of the code execution does not match anymore. So I must absolutely do > this in macros. >=20 >=20 > I=E2=80=99ve tried to get that working, but all my tries failed. Is there= a way > and can you show it to me? >=20 > This is a minimal working example. The output should stay the same, > except for part 4, which needs this change to work (see at the bottom), > but I would like to: >=20 > - replace Respond2 and Respond3 by something recursive, so resp can have > arbitrary high values (not infinite: max the length of the options) and > - replace the cond-clause by a call to the recursive macro. >=20 > (define-syntax-rule (respond consequence consequence2 ...) > (begin > (write consequence) > (when (not (null? '(consequence2 ...))) > (write (car (cdr (car `(consequence2 ...)))))))) >=20 > (define-syntax Respond1 > (lambda (x) > (syntax-case x () > ((_ ((question consequences ...) choices ...)) > #`(begin > (respond consequences ...))) > ((_ (choices ...)) > #`(begin #f))))) >=20 > (define-syntax Respond2 > (lambda (x) > (syntax-case x () > ((_ (choice choices ...)) > #`(begin > (Respond1 (choices ...)))) > ((_ (choices ...)) > #`(begin #f))))) >=20 > (define-syntax Respond3 > (lambda (x) > (syntax-case x () > ((_ (a b choices ...)) > #`(Respond1 (choices ...))) > ((_ (choices ...)) > #`(begin #f))))) >=20 >=20 > (define-syntax-rule (Choose resp . choices) > "Ask questions, apply consequences" > (cond > ((equal? resp 1) > (Respond1 choices)) > ((equal? resp 2) > (Respond2 choices)) > ((equal? resp 3) > (Respond3 choices)) > (else > #f))) >=20 >=20 > (display "Choose 1: should be bar:") > (Choose 1 (foo 'bar) (foo 'war 'har) (foo 'mar) (foo 'tar)) > (newline) > (display "Choose 2: should be warhar:") > (Choose 2 (foo 'bar) (foo 'war 'har) (foo 'mar) (foo 'tar)) > (newline) > (display "Choose 3: should be mar:") > (Choose 3 (foo 'bar) (foo 'war 'har) (foo 'mar) (foo 'tar)) > (newline) > (display "Choose 4: should be tar:") > (Choose 4 (foo 'bar) (foo 'war 'har) (foo 'mar) (foo 'tar)) > (newline) > (display "Choose 5: should be #f:") > (Choose 5 (foo 'bar) (foo 'war 'har) (foo 'mar) (foo 'tar)) > (newline) >=20 >=20 > Best wishes, > Arne Hello, Dr. Arne, would simply transforming the question . response pairs to a list of lists = of=20 responses work? E.G. #+begin_src scheme (define-syntax questions->responses (syntax-rules () ((_ (question response ...) choices ...) (cons (list response ...) (questions->responses choices ...))) ((_ choices ...) '()))) #+end_src Vale, =2DTim