perf(eshell): hoist find regexp; linear tokenizers
ober
087117b5a82cd3ce9819330f9ed57edf15a6345f
--- a/src/jerboa-emacs/eshell.ss +++ b/src/jerboa-emacs/eshell.ss @@ -370,6 +370,7 @@ (name-flag (member "-name" args)) (name-pattern (and name-flag (pair? (cdr name-flag)) (cadr name-flag))) + (name-rx (and name-pattern (pregexp (glob->regex name-pattern)))) (results '())) (if (not (and (file-exists? dir) (eq? 'directory (file-info-type (file-info dir))))) @@ -377,13 +378,9 @@ (begin (walk-dir! dir (lambda (path) - (if name-pattern - ;; Convert glob pattern to regex - (let* ((rx-str (glob->regex name-pattern)) - (rx (pregexp rx-str)) - (basename (path-strip-directory path))) - (when (pregexp-match rx basename) - (set! results (cons path results)))) + (if name-rx + (when (pregexp-match name-rx (path-strip-directory path)) + (set! results (cons path results))) (set! results (cons path results))))) (values (if (null? results) "" (string-append @@ -459,15 +456,17 @@ (def (glob->regex pattern) "Convert a simple glob pattern (with * and ?) to a regex." - (let loop ((chars (string->list pattern)) (acc "^")) - (if (null? chars) - (string-append acc "$") - (let ((ch (car chars))) - (cond - ((char=? ch #\*) (loop (cdr chars) (string-append acc ".*"))) - ((char=? ch #\?) (loop (cdr chars) (string-append acc "."))) - ((char=? ch #\.) (loop (cdr chars) (string-append acc "\\."))) - (else (loop (cdr chars) (string-append acc (string ch))))))))) + (let ((out (open-output-string))) + (write-char #\^ out) + (for-each (lambda (ch) + (cond + ((char=? ch #\*) (display ".*" out)) + ((char=? ch #\?) (write-char #\. out)) + ((char=? ch #\.) (display "\\." out)) + (else (write-char ch out)))) + (string->list pattern)) + (write-char #\$ out) + (get-output-string out))) ;;;============================================================================ ;;; Input processing @@ -475,32 +474,39 @@ (def (eshell-expand-env-vars str) "Expand $VAR and ${VAR} in a string." - (let loop ((chars (string->list str)) (acc "")) - (cond - ((null? chars) acc) - ((and (char=? (car chars) #\$) - (pair? (cdr chars)) - (char=? (cadr chars) #\{)) - ;; ${VAR} form - (let brace-loop ((rest (cddr chars)) (name "")) - (cond - ((null? rest) (loop rest (string-append acc "${" name))) - ((char=? (car rest) #\}) - (let ((val (getenv name ""))) - (loop (cdr rest) (string-append acc val)))) - (else (brace-loop (cdr rest) (string-append name (string (car rest)))))))) - ((and (char=? (car chars) #\$) - (pair? (cdr chars)) - (or (char-alphabetic? (cadr chars)) (char=? (cadr chars) #\_))) - ;; $VAR form - (let var-loop ((rest (cdr chars)) (name "")) - (if (and (pair? rest) - (let ((c (car rest))) - (or (char-alphabetic? c) (char-numeric? c) (char=? c #\_)))) - (var-loop (cdr rest) (string-append name (string (car rest)))) - (let ((val (getenv name ""))) - (loop rest (string-append acc val)))))) - (else (loop (cdr chars) (string-append acc (string (car chars)))))))) + (let ((out (open-output-string))) + (let loop ((chars (string->list str))) + (cond + ((null? chars) (get-output-string out)) + ((and (char=? (car chars) #\$) + (pair? (cdr chars)) + (char=? (cadr chars) #\{)) + ;; ${VAR} form + (let brace-loop ((rest (cddr chars)) (name '())) + (cond + ((null? rest) + (display "${" out) + (display (list->string (reverse name)) out) + (loop rest)) + ((char=? (car rest) #\}) + (display (getenv (list->string (reverse name)) "") out) + (loop (cdr rest))) + (else (brace-loop (cdr rest) (cons (car rest) name)))))) + ((and (char=? (car chars) #\$) + (pair? (cdr chars)) + (or (char-alphabetic? (cadr chars)) (char=? (cadr chars) #\_))) + ;; $VAR form + (let var-loop ((rest (cdr chars)) (name '())) + (if (and (pair? rest) + (let ((c (car rest))) + (or (char-alphabetic? c) (char-numeric? c) (char=? c #\_)))) + (var-loop (cdr rest) (cons (car rest) name)) + (begin + (display (getenv (list->string (reverse name)) "") out) + (loop rest))))) + (else + (write-char (car chars) out) + (loop (cdr chars))))))) (def (eshell-expand-glob token cwd) "Expand a glob token. Returns list of matching filenames, or (list token) if no glob chars." @@ -565,31 +571,39 @@ (def (eshell-expand-command-substitution line cwd) "Expand $(cmd) in a command line by executing cmd and inserting output." - (let loop ((chars (string->list line)) (acc "")) - (cond - ((null? chars) acc) - ((and (char=? (car chars) #\$) - (pair? (cdr chars)) - (char=? (cadr chars) #\()) - ;; Find matching closing paren - (let paren-loop ((rest (cddr chars)) (depth 1) (cmd "")) - (cond - ((null? rest) (string-append acc "$(" cmd)) - ((char=? (car rest) #\() - (paren-loop (cdr rest) (+ depth 1) (string-append cmd "("))) - ((and (char=? (car rest) #\)) (= depth 1)) - ;; Execute the command and get output - (let-values (((output _) (eshell-execute-command cmd cwd))) - (let ((trimmed-output (if (and (string? output) - (> (string-length output) 0) - (char=? (string-ref output (- (string-length output) 1)) #\newline)) - (substring output 0 (- (string-length output) 1)) - (if (string? output) output "")))) - (loop (cdr rest) (string-append acc trimmed-output))))) - ((char=? (car rest) #\)) - (paren-loop (cdr rest) (- depth 1) (string-append cmd ")"))) - (else (paren-loop (cdr rest) depth (string-append cmd (string (car rest)))))))) - (else (loop (cdr chars) (string-append acc (string (car chars)))))))) + (let ((out (open-output-string))) + (let loop ((chars (string->list line))) + (cond + ((null? chars) (get-output-string out)) + ((and (char=? (car chars) #\$) + (pair? (cdr chars)) + (char=? (cadr chars) #\()) + ;; Find matching closing paren + (let paren-loop ((rest (cddr chars)) (depth 1) (cmd '())) + (cond + ((null? rest) + (display "$(" out) + (display (list->string (reverse cmd)) out) + (get-output-string out)) + ((char=? (car rest) #\() + (paren-loop (cdr rest) (+ depth 1) (cons #\( cmd))) + ((and (char=? (car rest) #\)) (= depth 1)) + ;; Execute the command and get output + (let-values (((output _) + (eshell-execute-command (list->string (reverse cmd)) cwd))) + (let ((trimmed-output (if (and (string? output) + (> (string-length output) 0) + (char=? (string-ref output (- (string-length output) 1)) #\newline)) + (substring output 0 (- (string-length output) 1)) + (if (string? output) output "")))) + (display trimmed-output out) + (loop (cdr rest))))) + ((char=? (car rest) #\)) + (paren-loop (cdr rest) (- depth 1) (cons #\) cmd))) + (else (paren-loop (cdr rest) depth (cons (car rest) cmd)))))) + (else + (write-char (car chars) out) + (loop (cdr chars))))))) (def (eshell-process-input input cwd) "Process an eshell input line. @@ -639,24 +653,23 @@ "Parse a command line into a list of tokens. Simple splitting on whitespace, respecting double quotes." (let loop ((chars (string->list line)) - (current "") + (current '()) ; reversed char list for the token in progress (tokens '()) (in-quote? #f)) (cond ((null? chars) - (reverse (if (string=? current "") tokens - (cons current tokens)))) + (reverse (if (null? current) tokens + (cons (list->string (reverse current)) tokens)))) ((and (char=? (car chars) #\") (not in-quote?)) (loop (cdr chars) current tokens #t)) ((and (char=? (car chars) #\") in-quote?) (loop (cdr chars) current tokens #f)) ((and (char-whitespace? (car chars)) (not in-quote?)) - (if (string=? current "") - (loop (cdr chars) "" tokens #f) - (loop (cdr chars) "" (cons current tokens) #f))) + (if (null? current) + (loop (cdr chars) '() tokens #f) + (loop (cdr chars) '() (cons (list->string (reverse current)) tokens) #f))) (else - (loop (cdr chars) (string-append current (string (car chars))) - tokens in-quote?))))) + (loop (cdr chars) (cons (car chars) current) tokens in-quote?))))) (def (eshell-execute-command-with-redirect line cwd) "Execute a command with env/glob expansion, input and output redirection."