Unix-like filter elements in Common Lisp

cl-ulfe.lisp

;;; -*- Mode:Lisp ; Syntax:Common-Lisp -*-

;;; CL-ULFE: unix-like filter elements, by @nfunato on 2015-04-15
;;;   - placed in the public domain unless otherwise noted
;;;   - usually assumed to be used with CL-PPCRE

;(ql:quiciload 'cl-ppcre)
(require 'cl-ppcre)

(defvar *case-fold-p* t)
(defun ch=  (a b) (if *case-fold-p* (char-equal   a b) (char=   a b)))
(defun ch<  (a b) (if *case-fold-p* (char-lessp   a b) (char<   a b)))
(defun str= (a b) (if *case-fold-p* (string-equal a b) (string= a b)))
(defun str< (a b) (if *case-fold-p* (string-lessp a b) (string< a b)))

(defun nulls  (s) (string= s ""))

(defun trim (str)
  (let ((cs '(#\Space #\Tab #\Return #\Linefeed #\Backspace #\Rubout)))
    (string-trim cs str)))

(defun zap-to (ch str)
  (let ((p (position ch str :test #'ch=)))
    (if (null p) str (subseq str 0 p))))

(defun from-file (path &aux (eof (cons nil nil)))
  (labels ((tbrl (st) (trim (read-line st nil eof)))
           (trim (s)  (if (stringp s) (trim s) s)))
    (with-open-file (st path :direction :input)
      (loop for x = (tbrl st) until (eq x eof) unless (nulls x) collect x))))

(defun to-file (path xs)
  (with-open-file (st path :direction :output :if-exists :supersede)
    (loop for x in xs do (princ x st) (terpri st))))

(defun univ-input (x)   ; take input from either pathname or list
  (cond ((pathnamep x) (from-file x))
        ((listp     x) x)
        (t             (error "univ-input"))))

(defun from-arr   (ar)  (map 'list #'identity ar))
(defun to-arr     (xs)  (map 'simple-vector #'identity xs))
(defun print-arr  (ar)  (loop for x across ar do (princ x) (terpri)))
(defun print-list (xs)  (loop for x in     xs do (princ x) (terpri)))

(defun uniq (xs &key (test #'eql))
  (labels ((u (rest prev acc)
             (if (null rest)
                 (reverse acc)
                 (destructuring-bind (hd . tl) rest
                   (if (funcall test hd prev)
                       (u tl prev acc)
                       (u tl hd (cons hd acc)))))))
    (if xs
        (u (cdr xs) (car xs) (list (car xs))))))
(defun uniq-strs (strs) (uniq strs :test #'str=))
(defun sort-strs (strs) (sort strs #'str<))

(defun inter-strs (a b) (sort-strs (intersection   a b :test #'str=)))
(defun union-strs (a b) (sort-strs (union          a b :test #'str=)))
(defun sdiff-strs (a b) (sort-strs (set-difference a b :test #'str=)))

;; the following functions are basically from rosettacode.org

(defun begins-with (prefix str)
  (let ((p (search prefix str :test #'str=)))
    (and p (zerop p))))

(defun ends-with (sub str)
  (let ((p (mismatch sub str :from-end t :test #'str=)))
    (or (null p) (zerop p))))

(defun contains (sub str)
  (unless (nulls sub)
    (loop for p = (search sub str :test #'str=)
             then (search sub str :start2 (1+ p) :test #'str=)
          while p collect p)))

;;; FIXME:
;;;   perhaps incorporate some wrapper functions, such as
;;;   http://basicwerk.com/blog/archives/1554

#|
CL-USER> (ql:system-apropos "ppcre")
#<SYSTEM arnesi+.cl-ppcre-extras / arnesi+-20120909-darcs / quicklisp 2012-09-09>
#<SYSTEM arnesi.cl-ppcre-extras / arnesi-20101006-darcs / quicklisp 2012-09-09>
#<SYSTEM cl-ppcre / cl-ppcre-2.0.3 / quicklisp 2012-09-09>
#<SYSTEM cl-ppcre-template / cl-unification-20120208-cvs / quicklisp 2012-09-09>
#<SYSTEM cl-ppcre-test / cl-ppcre-2.0.3 / quicklisp 2012-09-09>
#<SYSTEM cl-ppcre-unicode / cl-ppcre-2.0.3 / quicklisp 2012-09-09>
#<SYSTEM parser-combinators-cl-ppcre / cl-parser-combinators-20120407-git / quicklisp 2012-09-09>
NIL
CL-USER> (ql:quickload :cl-ppcre)
To load "cl-ppcre":
  Load 1 ASDF system:
    cl-ppcre
; Loading "cl-ppcre"
[package cl-ppcre]................................
...........................
(:CL-PPCRE)
CL-USER> (defvar user-agent "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_6_6) AppleWebKit/534.28 (KHTML, like Gecko) Chrome/12.0.728.0 Safari/534.28")
USER-AGENT
CL-USER> (ppcre:scan-to-strings "M\\S+" user-agent)
"Mozilla/5.0"
#()
CL-USER> (ppcre:all-matches-as-strings "M\\S+" user-agent)
("Mozilla/5.0" "Macintosh;" "Mac" "ML,")
CL-USER> (defun m/re/g (re str)
           (ppcre:all-matches-as-strings re str))
M/RE/G
CL-USER> (m/re/g "\\d+" user-agent)
("5" "0" "10" "6" "6" "534" "28" "12" "0" "728" "0" "534" "28")
CL-USER>
|#

;;; Usage

(defvar *rex* "^DE(\d)+[.]*[ABT].$")

#+:PPCRE
(defun example (x)
  (uniq-strs
   (sort-strs
    (m/re/g *rex*
     (mapcar (lambda (x) (zap-to #\| x))
      (mapcar #'trim
       (univ-input x)))))))

;;; git diff --no-index -- file1 file2