From 1cda08dd4a8106a0a2b2dffd8f653f2be1c1d561 Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Sun, 9 Dec 2018 15:43:26 -0500 Subject: [PATCH] sed: Replace blank regexes with the last regex. --- gash/commands/sed.scm | 50 ++++++++++++++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 13 deletions(-) diff --git a/gash/commands/sed.scm b/gash/commands/sed.scm index 8f8d456..d7f9cc7 100644 --- a/gash/commands/sed.scm +++ b/gash/commands/sed.scm @@ -90,11 +90,34 @@ (define quit-tag (make-prompt-tag)) +(define (make-regexp-factory) + (let* ((previous-pattern #f) + (ht (make-hash-table)) + (make-regexp/memoized + (lambda args + (or (hash-ref ht args #f) + (let ((regexp (apply make-regexp args))) + (hash-set! ht args regexp) + regexp))))) + (lambda (pattern . flags) + (if (string-null? pattern) + (if previous-pattern + (apply make-regexp/memoized previous-pattern flags) + (error "SED: no previous regular expression")) + (begin + (set! previous-pattern pattern) + (apply make-regexp/memoized pattern flags)))))) + +(define regexp-factory + (make-parameter + (lambda _ + (error "SED: no regexp-factory available")))) + (define (substitute str pattern replacement flags) (let* ((global? (memq 'g flags)) (flags (cons (if (extended?) regexp/extended regexp/basic) (if (memq 'i flags) `(,regexp/icase) '()))) - (regexp (apply make-regexp (replace-escapes pattern) flags)) + (regexp (apply (regexp-factory) (replace-escapes pattern) flags)) (proc (replace->lambda (replace-escapes replacement) global?))) (match (list-matches regexp str) ((and m+ (_ _ ...)) (proc str m+)) @@ -104,7 +127,7 @@ (if (string? address) (let* ((flags `(,(if (extended?) regexp/extended regexp/basic))) (pattern (replace-escapes address)) - (regexp (apply make-regexp pattern flags))) + (regexp (apply (regexp-factory) pattern flags))) (cut regexp-exec regexp <>)) (error "SED: unsupported address type" address))) @@ -133,18 +156,19 @@ (define* (edit-stream commands #:optional (in (current-input-port)) (out (current-output-port))) - (let loop ((pattern-space (read-line in))) - (unless (eof-object? pattern-space) - (call-with-prompt quit-tag - (lambda () - (let ((result (execute-commands commands pattern-space))) + (parameterize ((regexp-factory (make-regexp-factory))) + (let loop ((pattern-space (read-line in))) + (unless (eof-object? pattern-space) + (call-with-prompt quit-tag + (lambda () + (let ((result (execute-commands commands pattern-space))) + (display result out) + (newline out) + (loop (read-line in)))) + (lambda (cont result) (display result out) - (newline out) - (loop (read-line in)))) - (lambda (cont result) - (display result out) - (newline out)))) - #t)) + (newline out)))) + #t))) (define (sed . args) (let* ((option-spec