diff options
| -rw-r--r-- | guix/build/bournish.scm | 62 |
1 files changed, 61 insertions, 1 deletions
diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm index 1f17e0a22d..928bef5b9e 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 <ludo@gnu.org> +;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; 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,63 @@ 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." + (let loop ((lines 0) (chars 0)) + (match (read-char port) + ((? eof-object?) ;done! + (values lines chars)) + (#\newline ;recurse + (loop (1+ lines) (1+ chars))) + (_ ;recurse + (loop lines (1+ chars)))))) + +(define (file-exists?* file) + "Like 'file-exists?' but emits a warning if FILE is not accessible." + (catch 'system-error + (lambda () + (stat file)) + (lambda args + (let ((errno (system-error-errno args))) + (format (current-error-port) "~a: ~a~%" + file (strerror errno)) + #f)))) + +(define (wc-print file) + (let-values (((lines chars) + (call-with-input-file file lines+chars))) + (format #t "~a ~a ~a~%" lines chars file))) + +(define (wc-l-print file) + (let-values (((lines chars) + (call-with-input-file file lines+chars))) + (format #t "~a ~a~%" lines file))) + +(define (wc-c-print file) + (let-values (((lines chars) + (call-with-input-file file lines+chars))) + (format #t "~a ~a~%" chars file))) + +(define (wc-command-implementation . files) + (for-each wc-print (filter file-exists?* files))) + +(define (wc-l-command-implementation . files) + (for-each wc-l-print (filter file-exists?* files))) + +(define (wc-c-command-implementation . files) + (for-each wc-c-print (filter file-exists?* files))) + +(define (wc-command . args) + "Emit code for the 'wc' command." + (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 +188,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-command))) (define (read-bournish port env) "Read a Bournish expression from PORT, and return the corresponding Scheme |