...
 
Commits (6)
......@@ -27,6 +27,7 @@
#:use-module (ice-9 receive)
#:use-module (ice-9 regex)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
......@@ -52,29 +53,24 @@
(sub? env-sub? set-env-sub?) ; bool - Made a substitution?
(labels env-labels)) ; alist - Labels for branching
(define (interpolate-match s m)
(let loop ((chrs (string->list s)) (acc '()))
(match chrs
(() (reverse-list->string acc))
((#\& . rest)
(loop rest (append-reverse (string->list (match:substring m)) acc)))
((#\\ (? char-numeric? chr) . rest)
(let* ((i (- (char->integer chr) (char->integer #\0)))
(ref (string->list (match:substring m i))))
(loop rest (append-reverse ref acc))))
((#\\ #\\ . rest) (loop rest (cons #\\ acc)))
((#\\ #\& . rest) (loop rest (cons #\& acc)))
((#\\ #\n . rest) (loop rest (cons #\newline acc)))
((#\\ #\r . rest) (loop rest (cons #\return acc)))
((#\\ #\t . rest) (loop rest (cons #\tab acc)))
((chr . rest) (loop rest (cons chr acc))))))
(define (replace->lambda string global?)
(define (replace->string m s)
(list->string
(let loop ((lst (string->list string)))
(cond ((null? lst) '())
((null? (cdr lst)) lst)
((and (eq? (car lst) #\\)
(char-numeric? (cadr lst)))
(let ((i (- (char->integer (cadr lst)) (char->integer #\0))))
(append (string->list (match:substring m i)) (loop (cddr lst)))))
((and (eq? (car lst) #\\)
(eq? (cadr lst) #\n))
(append '(#\newline) (cddr lst)))
((and (eq? (car lst) #\\)
(eq? (cadr lst) #\t))
(append '(#\tab) (cddr lst)))
((and (eq? (car lst) #\\)
(eq? (cadr lst) #\r))
(append '(#\return) (cddr lst)))
((and (eq? (car lst) #\\)
(eq? (cadr lst) #\\))
(append '(#\\ #\\) (cddr lst)))
(else (cons (car lst) (loop (cdr lst))))))))
(lambda (l m+)
;; Iterate over matches M+ and
;; return the modified line
......@@ -88,7 +84,7 @@
(string-concatenate-reverse r)))
((m . rest)
(let* ((refs (- (vector-length m) 2))
(replace (replace->string m string))
(replace (interpolate-match string m))
(replace (cons* replace (substring l o (match:start m)) r)))
(if global? (loop rest (match:end m) replace)
(loop '() (match:end m) replace))))))))
......
......@@ -426,7 +426,7 @@ next character statisfies @var{pred} (or is a newline)."
((or (? eof-object?)
(? operator-prefix-char?)
(? blank?)
#\newline #\#
#\newline
#\$ #\` #\' #\" #\\) (list->string (reverse! acc)))
(_ (loop (next-char port) (cons chr acc))))))
......@@ -449,8 +449,7 @@ next character statisfies @var{pred} (or is a newline)."
((or (? eof-object?)
(? operator-prefix-char?)
(? blank?)
#\newline
#\#) (acc->token acc chr))
#\newline) (acc->token acc chr))
((or #\$ #\`)
(if (expansions?)
(let ((expansion (get-expansion port)))
......
......@@ -353,7 +353,7 @@ of each thunk sent to the input of the next thunk."
(without-errexit test-thunk)
(cond
((= (get-status) 0)
(thunk)
(call-with-continue thunk)
(loop (get-status)))
(else
(set-status! last-status)))))))
......
......@@ -56,8 +56,24 @@
(not (member x '("." ".."))))))
#t)))))))))
(define bash*
(package
(inherit bash)
(arguments
(substitute-keyword-arguments (package-arguments bash)
((#:phases phases '%standard-phases)
`(modify-phases ,phases
;; Using [ expr1 -o expr2 ] is considered "obsolete" by the
;; POSIX spec.
(add-before 'install 'patch-install
(lambda* _
(substitute* "support/install.sh"
(("\\[ -f \\$src -o -d \\$src ]")
"[ -f $src ] || [ -d $src ]"))
#t))))))))
(define bash-without-bash
(let ((bash-bag (package->bag bash)))
(let ((bash-bag (package->bag bash*)))
(bag
(inherit bash-bag)
(build-inputs
......