From c32034d13d81010452158aea7ffbed29500af3b1 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 15 Jul 2018 13:37:19 +0200 Subject: [PATCH] command, builtin, glob, echo cleanup and fixes --- gash/builtins.scm | 49 +++++++++++++++++++++++------------------------ gash/gash.scm | 36 ---------------------------------- gash/peg.scm | 13 +------------ 3 files changed, 25 insertions(+), 73 deletions(-) diff --git a/gash/builtins.scm b/gash/builtins.scm index 0eced2f..a57e060 100644 --- a/gash/builtins.scm +++ b/gash/builtins.scm @@ -17,6 +17,7 @@ ;;; along with Gash. If not, see . (define-module (gash builtins) + #:use-module (ice-9 ftw) #:use-module (ice-9 getopt-long) #:use-module (ice-9 local-eval) #:use-module (ice-9 match) @@ -35,6 +36,7 @@ #:use-module (gash io) #:use-module (gash job) #:use-module (gash pipe) + #:use-module (gash util) #:export ( %builtin-commands @@ -74,8 +76,8 @@ (define (echo-command . args) (match args (() (newline)) - (("-n" args ...) (map display args)) - (_ (map display args) (newline)))) + (("-n" args ...) (display (string-join args))) + (_ (display (string-join args)) (newline)))) (define (bg-command . args) (match args @@ -419,25 +421,21 @@ Options: => (lambda (command) (if args - `(,apply ,command ',(map (cut local-eval <> (the-environment)) args)) - command))) + (apply command (map (cut local-eval <> (the-environment)) args)) + (command)))) (else #f))))) (define (command . args) (define (exec command) (cond ((procedure? command) command) - ((every string? command) (cut apply (compose status:exit-val system*) command)) - ;; not sure whether to do $?/PIPESTATUS here or in sh-exec ((every string? command) - (cut apply (compose (lambda (status) - ((compose (cut assignment "?" <>) number->string) status) - status) - (lambda (status) - (when (not (zero? status)) - (format (current-error-port) "*****gash: ~a: ~a" (car command) (strerror status))) - status) - status:exit-val - system*) command)) + (let* ((program (car command)) + (escape-builtin? (and (string? program) (string-prefix? "\\" program))) + (program (if escape-builtin? (string-drop program 1) program)) + (command (cons program (cdr command)))) + (or (builtin command #:prefer-builtin? (and %prefer-builtins? + (not escape-builtin?))) + (cut apply (compose status:exit-val system*) command)))) (else (lambda () #t)))) (exec (append-map glob args))) @@ -451,23 +449,24 @@ Options: (make-regexp (string-append "^" pattern "$")))) (define (glob-match regex path) ;; pattern path -> bool (regexp-match? (regexp-exec regex path))) - (define (glob- pattern paths) - (map (lambda (path) - (if (string-prefix? "./" path) (string-drop path 2) path)) - (append-map (lambda (path) - (map (cute string-append (if (string=? "/" path) "" path) "/" <>) + (define (glob- pattern file-names) + (map (lambda (file-name) + (if (string-prefix? "./" file-name) (string-drop file-name 2) file-name)) + (append-map (lambda (file-name) + (map (cut string-append (if (string=? "/" file-name) "" file-name) "/" <>) (filter (conjoin (negate (cut string-prefix? "." <>)) (cute glob-match (glob2regex pattern) <>)) - (or (scandir path) '())))) - paths))) + (or (scandir file-name) '())))) + file-names))) (cond ((not pattern) '("")) ((glob? pattern) (let ((absolute? (string-prefix? "/" pattern))) (let loop ((patterns (filter (negate string-null?) (string-split pattern #\/))) - (paths (if absolute? '("/") '(".")))) + (file-names (if absolute? '("/") '(".")))) (if (null? patterns) - paths - (loop (cdr patterns) (glob- (car patterns) paths)))))) + file-names + (begin + (loop (cdr patterns) (glob- (car patterns) file-names))))))) (#t (list pattern)))) (define (singlequotes . o) diff --git a/gash/gash.scm b/gash/gash.scm index f85567c..683ebee 100644 --- a/gash/gash.scm +++ b/gash/gash.scm @@ -145,42 +145,6 @@ copyleft. (_ o)))) (map expand- o)) - -;; TODO: add braces -(define (glob pattern) ;; pattern -> list of path - - (define (glob? pattern) - (string-match "\\?|\\*" pattern)) - - (define (glob2regex pattern) - (let* ((pattern (regexp-substitute/global #f "\\." pattern 'pre "\\." 'post)) - (pattern (regexp-substitute/global #f "\\?" pattern 'pre "." 'post)) - (pattern (regexp-substitute/global #f "\\*" pattern 'pre ".*" 'post))) - (make-regexp (string-append "^" pattern "$")))) - - (define (glob-match regex path) ;; pattern path -> bool - (regexp-match? (regexp-exec regex path))) - - (define (glob- pattern paths) - (map (lambda (path) - (if (string-prefix? "./" path) (string-drop path 2) path)) - (append-map (lambda (path) - (map (cute string-append (if (string=? "/" path) "" path) "/" <>) - (filter (conjoin (negate (cut string-prefix? "." <>)) - (cute glob-match (glob2regex pattern) <>)) - (or (scandir path) '())))) - paths))) - (cond - ((not pattern) '("")) - ((string-prefix? "$" pattern) (list (pk "get " pattern " => " (assoc-ref global-variables (string-drop pattern 1))))) ;; TODO: REMOVE ME - ((glob? pattern) (let ((absolute? (string-prefix? "/" pattern))) - (let loop ((patterns (filter (negate string-null?) (string-split pattern #\/))) - (paths (if absolute? '("/") '(".")))) - (if (null? patterns) - paths - (loop (cdr patterns) (glob- (car patterns) paths)))))) - (#t (list pattern)))) - (define (DEAD-background ast) (match ast (('pipeline fg rest ...) `(pipeline #f ,@rest)) diff --git a/gash/peg.scm b/gash/peg.scm index f7634ca..e3839c5 100644 --- a/gash/peg.scm +++ b/gash/peg.scm @@ -1,5 +1,4 @@ (define-module (gash peg) - #:use-module (ice-9 ftw) #:use-module (ice-9 local-eval) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) @@ -15,7 +14,6 @@ #:use-module (gash gash) #:use-module (gash io) #:use-module (gash job) - #:use-module (gash util) #:export ( parse @@ -211,16 +209,7 @@ (('substitution o) `(substitution ,@(transform o))) (('pipeline o) (pk `(pipeline ,(transform o)))) (('pipeline h t) (pk `(pipeline ,(transform h) ,@(map transform t)))) - (('command o ...) (let* ((command (map transform o)) - (program (car command)) - (escape-builtin? (and (string? program) (string-prefix? "\\" program))) - (program (if escape-builtin? (string-drop program 1) program)) - (command (cons program (cdr command)))) - (when (> %debug-level 1) - (format (current-error-port) "transform command=~s\n" command)) - (or (builtin command #:prefer-builtin? (and %prefer-builtins? - (not escape-builtin?))) - `(command ,@command)))) + (('command o ...) `(command ,@(map transform o))) (('literal o) (transform o)) (('name o) o) (('number o) o)