8324a5a60426

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