--- /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))))