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

refactor WORD...bummer: word-for-test-assign-sh word-for-test-if-sh

This commit is contained in:
Jan Nieuwenhuizen 2018-07-15 23:01:52 +02:00
parent 24c35cc5d9
commit 6468b04791
4 changed files with 57 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/gash.in
View File

@ -1,6 +1,6 @@
#! /bin/sh
# -*-scheme-*-
exec ${GUILE-guile} -L $(pwd)/bin -L $(pwd) -C $(pwd)/bin -C $(pwd) --no-auto-compile -e '(gash)' -s $0 "$@"
exec ${GUILE-guile} -L $(dirname $0) -L $(dirname $(dirname $0)) -C $(dirname $0) -C $(dirname $(dirname $0)) --no-auto-compile -e '(gash)' -s $0 "$@"
!#
(define-module (gash)
#:export (main))

13
gash/builtins.scm
View File

@ -54,6 +54,7 @@
script
if-clause
xtrace
word
bg-command
cd-command
@ -503,7 +504,10 @@ Options:
(string-join (append-map glob o) ""))
(define (sequence . args)
(append-map glob (apply append args)))
(pke 'sequence (append-map glob (apply append args)))
;;(pke 'sequence (map glob (pke 'apply-append (apply append (pke 'seq-args: args)))))
;;(list (apply append args))
)
(define (script . o)
o)
@ -520,8 +524,13 @@ Options:
(define (xtrace o)
(o))
(define (word . o)
(apply string-append o))
(define-syntax-rule (substitution commands)
(split (with-output-to-string (lambda _ commands))))
(let ((lst (pke 'split (split (pke 'string (with-output-to-string (lambda _ commands)))))))
(if (= (length lst) 1) (car lst)
lst)))
(define-syntax if-clause
(lambda (x)

62
gash/peg.scm
View File

@ -143,7 +143,13 @@
name <-- identifier
identifier <- [_a-zA-Z][_a-zA-Z0-9]*
oldword <- substitution / assignment / number / variable / delim / literal
word <-- assignment / delim / (substitution / number / variable / literal)+
word-for-test-assign-sh <-- assignment / (delim / number / variable / literal)+
word-for-test-if-sh <-- assignment / delim / (number / variable / literal)+
word <-- assignment / (delim / number / variable / literal)+
number <-- [0-9]+
lsubst < '$('
rsubst < ')'
@ -187,10 +193,12 @@
(format (current-error-port) "parse error: no match\n")
#f)))))
(define (flatten o)
(keyword-flatten '(and assignent command doublequotes for-clause literal name or pipeline singlequotes substitution word) o))
(define (parse input)
(let* ((pt (parse- input))
(foo (when (> %debug-level 1) (display "tree:\n") (pretty-print pt)))
(flat (keyword-flatten '(and assignent command literal name or pipeline substitution) pt))
(flat (flatten pt))
(foo (when (> %debug-level 0) (display "flat:\n") (pretty-print flat)))
(ast (transform flat))
(foo (when (> %debug-level 0) (display "ast:\n") (pretty-print ast))))
@ -222,43 +230,63 @@
(pretty-print ast (current-error-port)))
(match ast
;; FIXME: flatten?
((('pipeline _ ...) _ ...)
(map transform (keyword-flatten '(and assignent command literal name or pipeline substitution) ast)))
((('literal _ ...) _ ...)
(map transform (keyword-flatten '(and assignent command literal name or pipeline substitution) ast)))
((('assignent _ ...) _ ...) (map transform (flatten ast)))
((('command _ ...) _ ...) (map transform (flatten ast)))
((('doublequotes _ ...) _ ...) (map transform (flatten ast)))
((('for-clause _ ...) _ ...) (map transform (flatten ast)))
((('literal _ ...) _ ...) (map transform (flatten ast)))
((('pipeline _ ...) _ ...) (map transform (flatten ast)))
((('singlequotes _ ...) _ ...) (map transform (flatten ast)))
((('word _ ...) _ ...) (map transform (flatten ast)))
((('assignent _ ...) _ ...)
(map transform (keyword-flatten '(and assignent command literal name or pipeline substitution) ast)))
(('script o ...) `(script ,@(map transform o)))
(('pipeline o ...)
(let ((commands (map transform o)))
`(pipeline ,@(cons (trace commands) commands))))
`(pipeline ,@(cons (trace commands) commands))))
(('command o ...) `(command ,@(map transform o)))
(('literal o) (transform o))
(('name o) o)
(('number o) o)
(('assignment a b) `(assignment ,(transform a) ',(transform b)))
;;(('assignment a b) `(assignment ,(transform a) ',(transform b)))
;; FIXME: to quote or not?
(('assignment a b) `(assignment ,(transform a) ,(transform b)))
;; (('assignment a (and b ('literal _ ...))) `(assignment ,(transform a) ,(transform b)))
;; (('assignment a b)
;; `(assignment ,(transform a) ,(map transform b)))
(('for-clause name expr (and body ('pipeline _ ...)))
`(for ,(transform name) (lambda _ ,(transform expr)) (lambda _ ,(transform body))))
(('for-clause name expr body)
`(for ,(transform name) (lambda _ ,(transform expr)) (lambda _ ,@(transform body))))
`(for ,(transform name) (lambda _ ,(transform expr)) (lambda _ ,@(map transform body))))
(('sequence o)
`(sequence ,@(fold-right (lambda (o r)
(cons
(match o
(('substitution x) (transform o))
(_ `(list ,(transform o))))
r))
'() o)))
(('sequence o ...)
`(sequence ,@(fold-right (lambda (o r)
(cons
(match o
(('substitution x) (transform o))
(_ `(list ,(transform o))))
r))
'() o)))
(cons
(match o
(('substitution x) (transform o))
(_ `(list ,(transform o))))
r))
'() o)))
(('substitution o) `(substitution ,(transform o)))
(('if-clause expr then) `(if-clause ,(transform expr) ,(transform then)))
(('if-clause expr then else) `(if-clause ,(transform expr) ,(transform then) ,(transform else)))
(('then-part o ...) `(begin ,@(map transform o)))
(('else-part o ...) `(begin ,@(map transform o)))
(('word 'singlequotes) "")
(('word o) (transform o))
(('word o ...) `(string-append ,@(map transform o)))
(_ ast)))

4
test/assign.sh
View File

@ -1,6 +1,2 @@
ALLOCA=''
extras=' gettext.o'
REMOTE='stub'
objs="ar.o arscan.o commands.o dir.o expand.o file.o function.o getopt.o implicit.o job.o main.o misc.o read.o remake.o rule.o signame.o variable.o vpath.o default.o version.o getopt1.o remote-${REMOTE}.o ${extras} ${ALLOCA}"
#objs="remote-${REMOTE}.o"