diff mbox

Adding wc to Bournish

Message ID 20160605124033.GB859@debian-netbook
State New
Headers show

Commit Message

Efraim Flashner June 5, 2016, 12:40 p.m. UTC
I've been working more on this and I think it's much better now.
Currently it checks for `-l' or `-c' flags in the first position and
with some borrowing of code from the ls-command I've worked out
returning an error (out of order) when a file doesn't exist. And if
there's no flag then it attempts to read the first argument as a file
also.

bournish@(guile-user)> wc -l gpl-3.0.txt foo guix_cve
foo: No such file or directory
674 gpl-3.0.txt
25 guix_cve

Comments

Ludovic Courtès June 5, 2016, 8:37 p.m. UTC | #1
Efraim Flashner <efraim@flashner.co.il> skribis:

> I've been working more on this and I think it's much better now.
> Currently it checks for `-l' or `-c' flags in the first position and
> with some borrowing of code from the ls-command I've worked out
> returning an error (out of order) when a file doesn't exist. And if
> there's no flag then it attempts to read the first argument as a file
> also.

Neat, thanks for the update!

> From 0c37b8106ca8cf65e86029bdf89dfe50b7df8f87 Mon Sep 17 00:00:00 2001
> From: Efraim Flashner <efraim@flashner.co.il>
> Date: Sun, 22 May 2016 14:56:06 +0300
> Subject: [PATCH] Bournish: Add `wc' command.
>
> * guix/build/bournish.scm (%commands): Add wc command.

Incomplete.  :-)

[...]

> +(define (file-size file)
> +    (stat:size (stat file)))
> +
> +(define (wc-c-command file)
> +  ;; Faster when only `wc -c' is called
> +  (file-size file))
> +
> +(define (wc-l-command file)
> +  ;; Faster when only `wc -l' is called
> +  (stream-length
> +    (stream-filter
> +      (lambda (chr)
> +        (char=? chr #\newline))
> +      (port->stream (open-file file "r")))))
> +
> +(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* (wc-command-implementation file #:optional args)
> +  (let-values (((lines chars)
> +                (call-with-input-file file lines+chars)))
> +    (match args
> +      (#\l
> +       (format #t "~a ~a~%" lines file))
> +      (#\c
> +       (format #t "~a ~a~%" chars file))
> +      (_
> +       (format #t "~a ~a ~a~%" lines chars file)))))
> +
> +(define (wc-command args . rest)
> +  (let* ((flags (cond ((string=? args "-l") #\l)
> +                      ((string=? args "-c") #\c)
> +                      (else #\nul)))    ; no flags, "args" is a file
> +         (files (filter (lambda (file)
> +                          (catch 'system-error
> +                            (lambda ()
> +                              (lstat file))
> +                            (lambda args
> +                               (let ((errno (system-error-errno args)))
> +                                (format (current-error-port) "~a: ~a~%"
> +                                        file (strerror errno))
> +                                #f))))
> +                        (if (char=? flags #\nul) (cons args rest) rest))))
> +    (for-each
> +      (lambda (file)
> +        ((@@ (guix build bournish) wc-command-implementation) file flags))
> +    files)))

As discussed at
<https://lists.gnu.org/archive/html/guix-devel/2016-05/msg00782.html>,
remember that ‘wc-command’ is called by the compiler to generate Scheme
code from the input shell code.  Thus, it must emit code that does the
job.  However, here, it does the job directly, at compilation time, and
emits the result of ‘for-each’ as code.

I’ll commit a couple of fixes for bugs I just found and that prevent us
from doing:

  (compile "ls" #:from %bournish-language #:to 'scheme).

This is useful to clearly understand what code is generated from the
input.

Ludo’.
diff mbox

Patch

diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 4022796..480ce5f 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,7 +26,9 @@ 
   #: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)
+  #:use-module (srfi srfi-41)
   #:export (%bournish-language))
 
 ;;; Commentary:
@@ -103,6 +106,63 @@  characters."
        ((@ (guix build utils) dump-port) port (current-output-port))
        *unspecified*)))
 
+(define (file-size file)
+    (stat:size (stat file)))
+
+(define (wc-c-command file)
+  ;; Faster when only `wc -c' is called
+  (file-size file))
+
+(define (wc-l-command file)
+  ;; Faster when only `wc -l' is called
+  (stream-length
+    (stream-filter
+      (lambda (chr)
+        (char=? chr #\newline))
+      (port->stream (open-file file "r")))))
+
+(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* (wc-command-implementation file #:optional args)
+  (let-values (((lines chars)
+                (call-with-input-file file lines+chars)))
+    (match args
+      (#\l
+       (format #t "~a ~a~%" lines file))
+      (#\c
+       (format #t "~a ~a~%" chars file))
+      (_
+       (format #t "~a ~a ~a~%" lines chars file)))))
+
+(define (wc-command args . rest)
+  (let* ((flags (cond ((string=? args "-l") #\l)
+                      ((string=? args "-c") #\c)
+                      (else #\nul)))    ; no flags, "args" is a file
+         (files (filter (lambda (file)
+                          (catch 'system-error
+                            (lambda ()
+                              (lstat file))
+                            (lambda args
+                               (let ((errno (system-error-errno args)))
+                                (format (current-error-port) "~a: ~a~%"
+                                        file (strerror errno))
+                                #f))))
+                        (if (char=? flags #\nul) (cons args rest) rest))))
+    (for-each
+      (lambda (file)
+        ((@@ (guix build bournish) wc-command-implementation) file flags))
+    files)))
+
 (define (help-command . _)
   (display "\
 Hello, this is Bournish, a minimal Bourne-like shell in Guile!
@@ -129,7 +189,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