andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Support functions.

This commit is contained in:
Jan Nieuwenhuizen 2018-11-04 20:45:40 +01:00
parent a8a6ea06df
commit 8d0d50240b
10 changed files with 87 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
check.sh
View File

@ -16,6 +16,7 @@ tests="
01-script-backslash-twice.sh
03-echo
03-echo-doublequotes
03-echo-nesting
03-echo-escaped-doublequotes
03-echo-quoted-doublequotes
@ -65,6 +66,9 @@ tests="
50-iohere
60-function
60-subst
100-sed
100-sed-once
100-sed-global

32
gash/environment.scm
View File

@ -24,8 +24,11 @@
#:use-module (gash io)
#:export (
%command-line
%functions
%global-variables
assignment
function
set-shell-opt!
shell-opt?
variable
@ -33,6 +36,8 @@
variable-or
))
(define %command-line (make-parameter (command-line)))
;; FIXME: export/env vs set
(define %global-variables
(map identity ;; FIXME: make mutable
@ -46,6 +51,8 @@
(cons key value)))
(environ)))))
(define %functions '())
(define (assignment name value)
(and value
(set! %global-variables
@ -53,13 +60,20 @@
#t))
(define* (variable name #:optional (default ""))
(let ((name (if (string-prefix? "$" name) (string-drop name 1) name)))
(or (assoc-ref %global-variables name)
(if (shell-opt? "nounset") (begin
;; TODO: throw/error
(format (current-error-port) "gash: ~a: unbound variable\n" name)
#f)
default))))
(cond ((string->number name)
=>
(lambda (n)
(if (< n (length (%command-line))) (list-ref (%command-line) n)
"")))
((equal? name "#")
(number->string (length (%command-line))))
(else
(or (assoc-ref %global-variables name)
(if (shell-opt? "nounset") (begin
;; TODO: throw/error
(format (current-error-port) "gash: ~a: unbound variable\n" name)
#f)
default)))))
(define (variable-or name default)
(variable name default))
@ -79,3 +93,7 @@
(define (shell-opt? name)
(member name (string-split (assoc-ref %global-variables "SHELLOPTS") #\:)))
(define (function name body)
(set! %functions
(assoc-set! %functions name body)))

25
gash/peg.scm
View File

@ -160,14 +160,14 @@
pipeline-head <- sp* command
pipeline-tail <- sp* pipe ws* command
negate <-- '!'
command <-- (compound-command (sp+ io-redirect)*) / simple-command (sp+ io-redirect)* / function-def
command <-- function / (compound-command (sp+ io-redirect)*) / simple-command (sp+ io-redirect)*
compound-command <- brace-group / subshell / for-clause / case-clause / if-clause / while-clause / until-clause
simple-command <- (sp* (io-redirect sp+)* nonreserved)+
nonreserved <- &(reserved word) word / !reserved word
reserved < 'case' / 'esac' / 'if' / 'fi' / 'then' / 'else' / 'elif' / 'for' / 'done' / 'do' / 'until' / 'while'
function-def <-- name sp* lpar sp* rpar ws* (function-body / error)
function-body <-- compound-command io-redirect*
function <-- identifier sp* lpar sp* rpar ws* (function-body / error)
function-body <- compound-command io-redirect*
io-redirect <-- [0-9]* sp* (io-here / io-file)
io-file <-- ('<&' / '>&' / '>>' / '>' / '<>'/ '<' / '>|') sp* ([0-9]+ / filename)
@ -175,7 +175,7 @@
io-op < '<<-' / '<<' / '<&' / '>&' / '>>' / '>' / '<>'/ '<' / '>|'
io-suffix <- sp* here-label sp* nl
brace-group <-- '{' (sp* (compound-list / error) sp* '}' / error)
brace-group <-- lbrace (ws* (compound-list / error) ws* rbrace / error)
subshell <-- lpar compound-list separator rpar
compound-list <- term (separator term)*
@ -212,7 +212,7 @@
filename <-- word
name <-- identifier
identifier <- [_a-zA-Z][_a-zA-Z0-9]*
word <-- assignment / delim / (number / variable / variable-and-or / literal)+
word <-- assignment / (delim / number / variable / variable-and-or / literal)+
number <-- [0-9]+
lsubst < '$('
@ -223,8 +223,8 @@
rhs <- (substitution / word)*
assign < '='
dollar < '$'
literal <-- backslash? (!ws !amp !tick !dollar !pipe !semi !par !nl !sp !rbrace !io-op .)+
variable <-- dollar ('$' / '*' / '?' / '@' / [0-9] / identifier / lbrace identifier rbrace)
literal <-- backslash? (!ws !amp !tick !dollar !pipe !semi !par !nl !sp !rbrace !io-op !dq !sq .)+
variable <-- dollar ('$' / '#' / '*' / '?' / '@' / [0-9] / identifier / lbrace identifier rbrace)
variable-and-or <- dollar lbrace (variable-or / variable-and ) rbrace
variable-and <-- identifier plus rhs
variable-or <-- identifier minus rhs
@ -233,7 +233,7 @@
dq < [\"]
bt < [`]
singlequotes <-- sq (doublequotes / (!sq .))* sq
doublequotes <-- dq (singlequotes / substitution / variable / variable-and-or / (!dq .))* dq
doublequotes <-- dq (singlequotes / substitution / number / variable / variable-and-or / literal / (!dq .))* dq
break <- amp / semi !semi
separator <- (sp* break ws*) / ws+
sequential-sep <- (semi !semi ws*) / ws+
@ -301,6 +301,9 @@
(('script terms ...) `(script ,@(map transform terms)))
(('pipeline ('command command ('io-redirect ('io-file ">" file-name))))
(transform `(pipeline (command ,@(transform command)) (lambda _ (with-output-to-file ,(transform file-name) (lambda _ (display (read-string))))))))
(('pipeline o ...)
(let ((commands (map transform o)))
`(pipeline ,@(cons (trace commands) commands))))
@ -339,6 +342,12 @@
(('word 'singlequotes) "")
(('word o) (transform o))
(('word o ...) `(string-append ,@(map transform o)))
(('function name body)
`(function ,name (lambda ( . args) ,(transform body))))
(('brace-group o) `(brace-group ,(transform o)))
(('file-name o) `(file-name ,(transform o)))
(_ ast)))

16
gash/script.scm
View File

@ -22,6 +22,7 @@
#:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
#:use-module (ice-9 regex)
@ -41,9 +42,11 @@
#:export (
and-terms
background
brace-group
builtin
command
doublequotes
file-name
for
glob
if-clause
@ -72,6 +75,11 @@
(define (command . args)
(define (exec command)
(cond ((procedure? command) command)
((assoc-ref %functions (car command))
=>
(lambda (function)
(parameterize ((%command-line args))
(last (apply function args)))))
((every string? command)
(let* ((program (car command))
(escape-builtin? (and (string? program) (string-prefix? "\\" program)))
@ -155,7 +163,7 @@
(string-join (flatten o) ""))
(define-syntax-rule (substitution commands)
(with-output-to-string (lambda _ commands)))
(string-trim-right (with-output-to-string (lambda _ commands))))
(define-syntax-rule (ignore-error o)
(let ((errexit (shell-opt? "errexit")))
@ -271,3 +279,9 @@
(apply command (map (cut local-eval <> (the-environment)) args))
(command))))
(else #f)))))
(define (brace-group . o)
o)
(define (file-name o)
o)

1
test/03-echo-doublequotes.sh Normal file
View File

@ -0,0 +1 @@
echo "foo" b"ar"

1
test/03-echo-doublequotes.stdout Normal file
View File

@ -0,0 +1 @@
foo bar

8
test/60-function.sh Normal file
View File

@ -0,0 +1,8 @@
foo () {
echo $1
}
echo before
foo bar
foo baz
echo after

4
test/60-function.stdout Normal file
View File

@ -0,0 +1,4 @@
before
bar
baz
after

9
test/60-subst.sh Normal file
View File

@ -0,0 +1,9 @@
subst () {
sed \
-e s",foo,bar,"\
$1 > $2
}
subst test/data/foo foo.tmp
cat foo.tmp
rm foo.tmp

3
test/data/foo Normal file
View File

@ -0,0 +1,3 @@
foo
bar
baz