From patchwork Tue Jun 14 10:50:37 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Efraim Flashner X-Patchwork-Id: 13060 Received: (qmail 54099 invoked by uid 89); 14 Jun 2016 10:52:23 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Checked: by ClamAV 0.99.1 on sourceware.org X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.3 required=5.0 tests=AWL, BAYES_00, BODY_8BITS, GARBLED_BODY, RP_MATCHES_RCVD, SPF_PASS autolearn=no version=3.3.2 spammy=PORT, H*F:D*co.il, pipes, confidentiality X-Spam-Status: No, score=0.3 required=5.0 tests=AWL, BAYES_00, BODY_8BITS, GARBLED_BODY, RP_MATCHES_RCVD, SPF_PASS autolearn=no version=3.3.2 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on sourceware.org X-Spam-Level: X-HELO: lists.gnu.org Received: from lists.gnu.org (HELO lists.gnu.org) (208.118.235.17) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Tue, 14 Jun 2016 10:52:13 +0000 Received: from localhost ([::1]:34158 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bClx5-0001We-JU for patchwork@sourceware.org; Tue, 14 Jun 2016 06:52:11 -0400 Received: from eggs.gnu.org ([2001:4830:134:3::10]:43867) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bClvo-0000w4-EB for guix-devel@gnu.org; Tue, 14 Jun 2016 06:50:53 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bClvj-0001Ds-S7 for guix-devel@gnu.org; Tue, 14 Jun 2016 06:50:51 -0400 Received: from flashner.co.il ([178.62.234.194]:46420) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bClvj-0001DQ-FV for guix-devel@gnu.org; Tue, 14 Jun 2016 06:50:47 -0400 Received: from debian-netbook (85.65.166.137.dynamic.barak-online.net [85.65.166.137]) by flashner.co.il (Postfix) with ESMTPSA id BA17840305; Tue, 14 Jun 2016 10:50:39 +0000 (UTC) Date: Tue, 14 Jun 2016 13:50:37 +0300 From: Efraim Flashner To: Ricardo Wurmus Subject: Re: Adding wc to Bournish Message-ID: <20160614105037.GC10636@debian-netbook> References: <20160524184720.GA27449@debian-netbook> <20160605124033.GB859@debian-netbook> <87eg8bpe2v.fsf@gnu.org> <20160607074155.GB32264@debian-netbook> <878tyfelf6.fsf@gnu.org> <20160614092713.GA2832@debian-netbook> <20160614102029.GB10636@debian-netbook> MIME-Version: 1.0 Content-Disposition: inline In-Reply-To: <20160614102029.GB10636@debian-netbook> User-Agent: Mutt/1.6.1 (2016-04-27) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 178.62.234.194 X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: guix-devel@gnu.org Errors-To: guix-devel-bounces+patchwork=sourceware.org@gnu.org Sender: "Guix-devel" On Tue, Jun 14, 2016 at 01:20:29PM +0300, Efraim Flashner wrote: > On Tue, Jun 14, 2016 at 11:57:26AM +0200, Ricardo Wurmus wrote: > > > > Efraim Flashner writes: > > > > > +(define wc-command-implementation > > > + (lambda files > > > + (let ((files (filter (lambda (file) > > > + (catch 'system-error > > > + (lambda () > > > + (stat file)) > > > + (lambda args > > > + (let ((errno (system-error-errno args))) > > > + (format (current-error-port) "~a: ~a~%" > > > + file (strerror errno)) > > > + #f)))) > > > + files))) > > > + (for-each > > > + (lambda (file) > > > + (let-values (((lines chars) > > > + (call-with-input-file file lines+chars))) > > > + (format #t "~a ~a ~a~%" lines chars file))) > > > + files)))) > > > + > > > +(define wc-l-command-implementation > > > + (lambda files > > > + (let ((files (filter (lambda (file) > > > + (catch 'system-error > > > + (lambda () > > > + (stat file)) > > > + (lambda args > > > + (let ((errno (system-error-errno args))) > > > + (format (current-error-port) "~a: ~a~%" > > > + file (strerror errno)) > > > + #f)))) > > > + files))) > > > + (for-each > > > + (lambda (file) > > > + (let-values (((lines chars) > > > + (call-with-input-file file lines+chars))) > > > + (format #t "~a ~a~%" lines file))) > > > + files)))) > > > + > > > +(define wc-c-command-implementation > > > + (lambda files > > > + (let ((files (filter (lambda (file) > > > + (catch 'system-error > > > + (lambda () > > > + (stat file)) > > > + (lambda args > > > + (let ((errno (system-error-errno args))) > > > + (format (current-error-port) "~a: ~a~%" > > > + file (strerror errno)) > > > + #f)))) > > > + files))) > > > + (for-each > > > + (lambda (file) > > > + (let-values (((lines chars) > > > + (call-with-input-file file lines+chars))) > > > + (format #t "~a ~a~%" chars file))) > > > + files)))) > > > > It looks to me that the filter function is the same in all of these > > procedures. Even the actual implementation, i.e. the for-each over the > > resulting files is almost exactly the same. > > > > This could be simplified. If only the format expression differs then > > you could abstract this difference away. You could still have three > > different procedures, but they can be the result of evaluating a > > higher-order function. > > > > It also seems to me that you could use syntactic sugar to simplify > > “(define something (lambda ...))” to “(define (something ...))”. > > > > ~~ Ricardo > > It's already calling `((@@ (guix build bournish) > wc-l-command-implementation) ,@(delete "-l" args)), I could try changing > the ,@(delete part to ,@((@@ (guix build bournish) only-files) ,@(delete > "-l" args)) and then the various implementation functions will be just > printing the results > It turns out I forgot that calling only-files from wc-commands would make it evaluate too soon, so I stuck it inside the different implementations. Factoring out the check if a file exists or not could also apply to the ls-command-implementation too later. diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm index 1f17e0a..a8f6591 100644 --- a/guix/build/bournish.scm +++ b/guix/build/bournish.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Ludovic Courtès +;;; Copyright © 2016 Efraim Flashner ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:export (%bournish-language)) @@ -103,6 +105,59 @@ characters." ((@ (guix build utils) dump-port) port (current-output-port)) *unspecified*))) +(define (lines+chars port) + ;; Return the number of lines and number of chars read from PORT. + ;; TODO: Also return the number of words. + (let loop ((lines 0) (chars 0)) + (match (read-char port) ; get the next char ready + ((? eof-object?) ;done! + (values lines chars)) + (#\newline ;recurse + (loop (1+ lines) (1+ chars))) + (_ ;recurse + (loop lines (1+ chars)))))) + +(define (only-files files) + (filter (lambda (file) + (catch 'system-error + (lambda () + (stat file)) + (lambda args + (let ((errno (system-error-errno args))) + (format (current-error-port) "~a: ~a~%" + file (strerror errno)) + #f)))) + files)) + +(define (wc-command-implementation . files) + (for-each + (lambda (file) + (let-values (((lines chars) + (call-with-input-file file lines+chars))) + (format #t "~a ~a ~a~%" lines chars file))) + ((@@ (guix build bournish) only-files) files))) + +(define (wc-l-command-implementation . files) + (for-each + (lambda (file) + (let-values (((lines chars) + (call-with-input-file file lines+chars))) + (format #t "~a ~a~%" lines file))) + ((@@ (guix build bournish) only-files) files))) + +(define (wc-c-command-implementation . files) + (for-each + (lambda (file) + (let-values (((lines chars) + (call-with-input-file file lines+chars))) + (format #t "~a ~a~%" chars file))) + ((@@ (guix build bournish) only-files) files))) + +(define (wc-commands . args) + (cond ((member "-l" args) `((@@ (guix build bournish) wc-l-command-implementation) ,@(delete "-l" args))) + ((member "-c" args) `((@@ (guix build bournish) wc-c-command-implementation) ,@(delete "-c" args))) + (else `((@@ (guix build bournish) wc-command-implementation) ,@args)))) + (define (help-command . _) (display "\ Hello, this is Bournish, a minimal Bourne-like shell in Guile! @@ -129,7 +184,8 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n")) ("help" ,help-command) ("ls" ,ls-command) ("which" ,which-command) - ("cat" ,cat-command))) + ("cat" ,cat-command) + ("wc" ,wc-commands))) (define (read-bournish port env) "Read a Bournish expression from PORT, and return the corresponding Scheme