From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Alex Vong Newsgroups: gmane.lisp.guile.user Subject: Re: string-unfold demo Date: Mon, 28 Aug 2017 16:56:50 +0800 Message-ID: <87shgcjcj1.fsf@gmail.com> References: <8AE545E7-749B-4EF5-AFD8-7DA4340D1C39@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Trace: blaine.gmane.org 1503910663 15316 195.159.176.226 (28 Aug 2017 08:57:43 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 28 Aug 2017 08:57:43 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) Cc: Guile User To: Matt Wette Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Mon Aug 28 10:57:38 2017 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dmFrQ-0003Um-Mt for guile-user@m.gmane.org; Mon, 28 Aug 2017 10:57:32 +0200 Original-Received: from localhost ([::1]:37563 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dmFrX-0006cO-Er for guile-user@m.gmane.org; Mon, 28 Aug 2017 04:57:39 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:38632) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dmFr6-0006cJ-K5 for guile-user@gnu.org; Mon, 28 Aug 2017 04:57:13 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dmFr3-0005Gf-FK for guile-user@gnu.org; Mon, 28 Aug 2017 04:57:12 -0400 Original-Received: from mail-pg0-x235.google.com ([2607:f8b0:400e:c05::235]:35224) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dmFr3-0005Fw-8l for guile-user@gnu.org; Mon, 28 Aug 2017 04:57:09 -0400 Original-Received: by mail-pg0-x235.google.com with SMTP id 63so22242264pgc.2 for ; Mon, 28 Aug 2017 01:57:07 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=F9CkYzITaQZfeZeulIshuHhAx2Emk9THISFqZ8WjB/g=; b=JTksLd1uZ9xiLHBqn+Di01VLsyHyWpiTjXM3fqal85t2TprJltCi9d7dI7+RanDMcT bo4RCBR26J90S4oY1XDS8UB8DC97Fe8WDNNxZmgOPUzmG4AJl3u3PJwSnvvDccYbLESZ GVP/wGm9ALJ2qisrGHsNDGcM7XZ+HRkliIwutykT6Kc/QqWuSkpinOswQpz52BBY9jKR 2smCimVO0YNj54pwt7rGL2hEmQLLBWHs2UvFXoN1e4AYtreNvP+O2/HwmC5V6XtRVfTO JS0pZ0xwmFawhVfrv1VkGAfGXafWK6gb9mdq/PxyvVPbzsyjSatcZTFSTCBCwfIHAmbb 6NXw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=F9CkYzITaQZfeZeulIshuHhAx2Emk9THISFqZ8WjB/g=; b=KnbuwoiMXerXtrKXGDwjk7LjmX1qzdZTIYebInuVvP2bl/0SK2SRqvYP+TpUTxlP6o iKUG8uBg+S0zRWL3+/qR1AW8sKhmZUNkn/0hvuTBP7CvrEkbgyXtW8D/O6R0qEWt5qAH ba1mPMF7kLCBLaHeuqGZugmKFIeYmThRcgmIeMmZ4KS/wF6qPHOjxHMmhFDNRlNcDMiN Pexk6uoqyCBIiXqFA5Mmz2C2O48CqS/32QR1KAgkh9XZOPIa/pDcsOhmeeQ7Yh4GXuMS Ecgy3iGy91TkYOlyCjuZ7e96AY5A/vprlGMbeZ/v4Quxr59xQdzQmtS3uNpb/zgoIwqz tcEQ== X-Gm-Message-State: AHYfb5igkUH6EugbXmfFQ1kXyQc+c1ndNnCztlozRIPSyHEgii+kGsj6 6dJeYnnox19dcn9e X-Received: by 10.84.173.129 with SMTP id p1mr1806096plb.205.1503910626739; Mon, 28 Aug 2017 01:57:06 -0700 (PDT) Original-Received: from debian (1-64-81-064.static.netvigator.com. [1.64.81.64]) by smtp.gmail.com with ESMTPSA id y82sm17953286pfb.32.2017.08.28.01.57.04 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 28 Aug 2017 01:57:05 -0700 (PDT) In-Reply-To: <8AE545E7-749B-4EF5-AFD8-7DA4340D1C39@gmail.com> (Matt Wette's message of "Sat, 26 Aug 2017 10:38:14 -0700") X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:400e:c05::235 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.21 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.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.org gmane.lisp.guile.user:14072 Archived-At: --=-=-= Content-Type: text/plain Hello Guilers, Since I find this exercise interesting, I come up with another demo. The trick is to think of string as a list of characters (like in Haskell) and to use the fact that append can be written as an unfold. Let's begin: 1. Use SRFI-1 and SRFI-26 (use-modules (srfi srfi-1) (srfi srfi-26)) 2. Implement append using unfold (define (append a b) (unfold null? car cdr a (const b))) Test it: (append '(1 2 3) '(4 5 6)) => (1 2 3 4 5 6) 3. Extend append to allow any number of arguments (define append (lambda args (define (%append a b) (unfold null? car cdr a (const b))) (fold-right %append '() args))) Test it: (append '(1 2 3) '(4 5 6) '(7 8 9)) => (1 2 3 4 5 6 7 8 9) 4. "Port" the procedure to "string"-land First, notice 'unfold' takes a TAIL-GEN procedure to generate the tail, while string-unfold takes a BASE string, not a procedure. So, let's replace '(const b)' with 'b'. Next, replace 'null?' with 'string-null?', 'car' with '(cut string-ref <> 0)' and 'cdr' with '(cut string-drop <> 1)' (define (string-append a b) (string-unfold string-null? (cut string-ref <> 0) (cut string-drop <> 1) a b)) Test it: (string-append "123" "456") => "456123" Oops, we got the a and b reversed. 5. Reverse a and b (define (string-append a b) (string-unfold string-null? (cut string-ref <> 0) (cut string-drop <> 1) b a)) Test it: (string-append "123" "456") => "123456" Now it works. 6. Extend again to allow any number of arguments (define string-append (lambda args (define (%string-append a b) (string-unfold string-null? (cut string-ref <> 0) (cut string-drop <> 1) b a)) (fold-right %string-append "" args))) Test it: (string-append "123" "456" "789") => "123456789" DONE! Cheers, Alex Matt Wette writes: > Just for kicks, to learn string-unfold, I made an ugly version of string-append: > > (define (ugly-string-append . str-l) > > ;; p: seed |-> #t|#f predicate to indicate stop > (define (p seed) (null? seed)) > > ;; f: seed |-> char output function > (define (f seed) (string-ref (cddar seed) (caar seed))) > > ;; g: seed |-> seed transition function > (define (g seed) (let* ((head (car seed)) (tail (cdr seed)) > (ix (car head)) (ln (cadr head)) (st (cddr head))) > (if (eq? (1+ ix) ln) tail > (cons (cons* (1+ ix) ln st) tail)))) > > ;; s: seed = ((ix1 ln1 . st1) (ix2 ln2 . st2) ...) > ;; where ix is curr index, ln is string-length, and st is string > (define s (map (lambda (s) (cons* 0 (string-length s) s)) str-l)) > > (string-unfold p f g s)) > > (ugly-string-append "abc" "def") => "abcdef" --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCgAdFiEEdZDkzSn0Cycogr9IxYq4eRf1Ea4FAlmj2tMACgkQxYq4eRf1 Ea6HvxAAnLMStbvqIULoOD/WffocZd6UuA2mGCFIZFc1DjT7aKQNqyDRis55vc7Y 4ENEo+Wt497PXomqLTceuho9+7paMGByDIbHg2pDznWKv1ZPppfjR0WPTnfcvoAn rgN8PPdBfamOwNZHkvGRBunaIC1GEGFjLmGrOxvw6q0Kr/0pE5KIG758DIhPNgba E5zJjxlAv5GwDSV1Xap5KSTCHhP9+m7IWA+nx2H+ZGrTUT2YFTMd0xYAbmx+ePdT CQYdke1XwwtcnAhUplURa/adz+0Y8Yaa08YByEL9Dm18e9sG0hXtQ2j9i+vKWdjg rVCQ4UsplLlJKh/xVpIYbNngYp4c3BVWCsIoTcVdEj6+AJ8TxYdDffzn9wIyZ0qA nlopSSwxPOOCA5AVIDSd/V5HWbLWZ7g+Z1fCvtJy/E8DJGOKZdyxIkDUlFbe/vrk 8kku1sxdzhDTd28iMpus2+YzTsejrn9zvwS1D0VqLS2bJ7qnIcPfj+Cg0HkPsFtk augRXr0NBtK3CuOMFI4NlzGfxpDhSOOHNWPjSp2vRt9cJHRxmsh0tJl1KOtWmY4+ VpKJtvdFp9+TdRw3DfFGgsTfPr5byvevNKBG7HX6Fc1oL/9HqX+FTc5DsZeGc7na REEYAWa1kMYn3MN4GTb4sGPr7AVj3/D8bMdFa0cNd1Px6XFoMYg= =qbFS -----END PGP SIGNATURE----- --=-=-=--