# HG changeset patch # User Steve Losh # Date 1545436367 18000 # Node ID 8324a5a604265ec208b428eafa2fbd09bfc40ade # Parent 159c993863c4f601def19e60175e2b874c1417ac Reimplement grep diff -r 159c993863c4 -r 8324a5a60426 lisp/search.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/search.lisp Fri Dec 21 18:52:47 2018 -0500 @@ -0,0 +1,87 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload '(:adopt :cl-ppcre) :silent t)) + + +;;;; Functionality ------------------------------------------------------------ +(defun make-scanner (pattern &key literal) + (let ((ppcre:*use-bmh-matchers* t) + (ppcre:*optimize-char-classes* :charmap) + (ppcre:*regex-char-code-limit* 128)) + (ppcre:create-scanner (if literal + `(:sequence ,pattern) + (ppcre:parse-string pattern))))) + +(defun search-stream (scanner stream &key invert) + (loop + :for line = (read-line stream nil nil nil) + :while line + :when (eq invert (not (ppcre:scan scanner line))) + :do (write-line line))) + +(defun search-file (scanner path &key invert) + (with-open-file (stream path :external-format '(:ascii :replacement #\?)) + (search-stream scanner stream :invert invert))) + +(defun run (pattern paths &key literal invert) + (loop + :with scanner = (make-scanner pattern :literal literal) + :for path :in paths + :do (if (string= "-" path) + (search-stream scanner *standard-input* :invert invert) + (search-file scanner path :invert invert)))) + + +;;;; CLI ---------------------------------------------------------------------- +(adopt:define-string *documentation* + "A simple reimplementation of grep in Common Lisp. FILEs will be searched ~ + for lines that match PATTERN and matching lines will be printed.~@ + ~@ + Perl-compatible regular expressions are supported.~@ + ~@ + If no FILEs are given, standard input will be searched. Standard input can ~ + also be searched by specifying - as a filename.") + +(adopt:define-interface *ui* + (:name "search" + :usage "PATTERN [FILE...]" + :summary "Print lines that match a regular expression." + :documentation *documentation*) + (help + :documentation "display help and exit" + :long "help" + :short #\h + :reduce (constantly t)) + (literal + :documentation "treat PATTERN as a literal string instead of a regex" + :long "literal" + :short #\l + :reduce (constantly t)) + ((no-literal literal) + :documentation "treat PATTERN as a regex (the default)" + :long "no-literal" + :short #\L + :reduce (constantly nil)) + (invert + :documentation "print non-matching lines" + :long "invert" + :short #\v + :initial-value nil + :reduce (constantly t)) + ((no-invert invert) + :documentation "print matching lines (the default)" + :long "no-invert" + :short #\V + :reduce (constantly nil))) + +(defun toplevel () + (handler-case + (multiple-value-bind (arguments options) (adopt:parse-options *ui*) + (when (gethash 'help options) + (adopt:print-usage-and-exit *ui*)) + (when (null arguments) + (error "PATTERN is required")) + (destructuring-bind (pattern . paths) arguments + (run pattern (or paths (list "-")) + :literal (gethash 'literal options) + :invert (gethash 'invert options)))) + (error (c) (adopt:print-error-and-exit c))))