Created
August 28, 2013 08:15
-
-
Save chiku-samugari/6363435 to your computer and use it in GitHub Desktop.
Live coding session at Lisp Meet Up #8 Devide the resulst of ``ls -l'' command into 2 sets by modulo 2 of the 2nd column (hard link count field) and sum up the 5th field (byte size field) of each set. Following code is available only for SBCL because PAPPLY macro depends on SB-C package.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defparameter *sample* | |
(butlast (cdr (maplist (lambda (lst) | |
(when (cadr lst) | |
(subseq (str<-textfile "sample") | |
(1+ (car lst)) | |
(cadr lst)))) | |
(cons -1 (position-list #\Newline (str<-textfile "sample"))))))) | |
(ql:quickload :split-sequence) | |
(let (even-set odd-set) | |
(dolist (line *sample*) | |
(let ((aline (remove "" (split-sequence:split-sequence #\Space line) :test #'equal))) | |
(cond ((evenp (parse-integer (second aline))) | |
(push (fifth aline) even-set)) | |
((oddp (parse-integer (second aline))) | |
(push (fifth aline) odd-set)) | |
(t 'YOU-ARE-STUPID!)))) | |
(list (reduce (papply (+ _ (parse-integer _))) | |
(cdr even-set) | |
:initial-value (parse-integer (car even-set))) | |
(reduce (papply (+ _ (parse-integer _))) | |
(cdr odd-set) | |
:initial-value (parse-integer (car odd-set))))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
total 400 | |
drwxr-xr-x 11 chiku staff 374 8 12 13:19 GLES20 | |
drwxr-xr-x 3 chiku staff 102 7 14 18:12 Haskell | |
drwxr-xr-x 12 chiku staff 408 7 14 18:22 L5 | |
drwxr-xr-x 30 chiku staff 1020 7 14 18:19 OCaml | |
drwxr-xr-x 3 chiku staff 102 8 16 05:12 R | |
drwxr-xr-x 6 chiku staff 204 7 14 18:24 androidccl | |
drwxr-xr-x 3 chiku staff 102 7 14 18:12 clojure | |
drwxr-xr-x 6 chiku staff 204 7 14 18:17 completion-driver | |
drwxr-xr-x 12 chiku staff 408 7 14 18:17 gwt-bvh | |
drwxr-xr-x 3 chiku staff 102 7 14 18:12 html | |
drwxr-xr-x 3 chiku staff 102 7 14 18:12 javascript | |
drwxr-xr-x 43 chiku staff 1462 8 26 20:28 lisp | |
drwxr-xr-x 4 chiku staff 136 7 14 18:17 p-parser | |
drwxr-xr-x 3 chiku staff 102 7 14 18:12 perl | |
drwxr-xr-x 8 chiku staff 272 7 14 18:16 postscript | |
drwxr-xr-x 20 chiku staff 680 7 14 18:15 practicals-1.0.3 | |
-rw-r--r-- 1 chiku staff 204800 12 18 2012 practicals-1.0.3.tar.gz | |
drwxr-xr-x 17 chiku staff 578 7 14 18:29 rlwrap-filters | |
drwxr-xr-x 5 chiku staff 170 8 26 20:28 scheme | |
drwxr-xr-x 9 chiku staff 306 7 14 18:19 screen | |
drwxr-xr-x 4 chiku staff 136 7 14 18:13 sh | |
drwxr-xr-x 6 chiku staff 204 7 15 00:04 sqlite3 | |
drwxr-xr-x 3 chiku staff 102 8 16 10:22 vimscript |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun concat-str (&rest strs) | |
(apply #'concatenate (cons 'string strs))) | |
(defun str<-textfile (filename &optional (omit-pred #'null)) | |
" The parameter ``omit-pred'' is used as a predicator for line-wise | |
checking of taking that line or not." | |
(with-open-file (in filename :direction :input) | |
(when in | |
(do ((line (read-line in nil nil) (read-line in nil nil)) | |
(str "")) | |
((null line) str) | |
(unless (funcall omit-pred line) | |
(setf str (concat-str str line (string #\newline)))))))) | |
(defun position-list (item seq &key (key #'identity) (test #'eql)) | |
(labels ((rec (s acc) | |
(let ((pos (position item s :key key :test test))) | |
(if pos | |
(rec (subseq s (1+ pos)) (cons (1+ pos) acc)) | |
(nreverse (maplist #'(lambda (x) (reduce #'+ x)) acc)))))) | |
(rest (rec seq (list -1))))) | |
(eval-when (:load-toplevel :compile-toplevel :execute) | |
(defun maptree (func tree &key (pred #'atom)) | |
(if (funcall pred tree) (funcall func tree) | |
(mapcar #'(lambda (x) (maptree func x :pred pred)) tree)))) | |
(defmacro with-tree-leaves (tree test-form result-form) | |
`(maptree (lambda (leaf) (if ,test-form ,result-form leaf)) ,tree)) | |
(defmacro with-gensyms ((&rest names) &body body) | |
`(let ,(loop for n in names collect `(,n (gensym))) | |
,@body)) | |
(defun last1 (lst) (car (last lst))) | |
(defmacro dequeue! (lst) | |
(with-gensyms (alt-lst) | |
`(let ((,alt-lst ,lst)) | |
(prog1 (last1 ,alt-lst) | |
(setf ,alt-lst (butlast ,alt-lst)) | |
(setf ,lst ,alt-lst))))) | |
(eval-when (:load-toplevel :compile-toplevel :execute) | |
(defun count-underscore (tree) | |
(let ((c 0)) | |
(with-tree-leaves tree (eq leaf '_) (incf c)) | |
c))) | |
(defmacro papply-listup-format (fn &rest applying-args &environment env) | |
(let* ((gensym-lst) | |
(body (with-tree-leaves applying-args | |
(eq leaf '_) | |
(car (push (gensym "PARG") gensym-lst))))) | |
(with-gensyms (not-applied-args) | |
`(lambda (,@(mapcan (lambda (x) | |
(loop repeat (count-underscore x) | |
collect (dequeue! gensym-lst))) | |
applying-args) | |
&rest ,not-applied-args) | |
(apply | |
,(if (symbolp fn) | |
(if (member fn (sb-c::lexenv-vars env) :key #'car :test #'eq) | |
fn `#',fn) | |
fn) | |
,@body ,not-applied-args))))) | |
(defmacro papply-form-format ((op &rest applying-args)) | |
`(papply-listup-format ,op ,@applying-args)) | |
(defmacro papply (&rest op-and-args) | |
" papply (op &rest applying-args) => function ;{{{ | |
papply op &rest applying-args => function | |
op : a symbol or function object. | |
applying-args : objects. | |
function : a function object. | |
This macro basically generates a function object by applying the first | |
m argument of ``op'' to ``applying-args.'' m is the number of elemetns | |
in ``applying-args'' except the symbol ``_''. | |
Special symbol ``_'' works as the place holder for not-yet-applied | |
arguments. The nth ``_'' is replaced by the nth argument of the result | |
function object. The order is from left to right. In other terminology, | |
depth-first-order. | |
Symbols are valid to be specified to ``op.'' If a symbol is given | |
for ``op'', then normaly it is treated as a symbol of a function. | |
But if the symbol is a variable which is lexically bound, then it is | |
treated as a variable. If you want to pass the function which is | |
indicated by that symbol in such a case, use function object instaed | |
of symbol (just put #' in front of the symbol). | |
This macro accepts 2 different format. One is called ``form format'' | |
because it seems like one form: | |
(papply (cons (+ 1 _))) | |
The another format is called ``listup format'' because it list up | |
the function and its argument one by one: | |
(papply #'cons (+ 1 _)) | |
Both of them accepts some more variations. As described above, ``op'' | |
can be a symbol that denotes a (globally defined) function or a symbol | |
that is used as a lexical variable and bound to a function object. | |
Thus, all follwing format is the same thing. | |
(papply (cons (+ 1 _))) | |
(papply (#'cons (+ 1 _))) | |
(let ((- #'cons)) | |
(papply (- (+ 1 _)))) | |
(papply #'cons (+ 1 _)) | |
(papply cons (+ 1 _)) | |
(let ((- #'cons)) | |
(papply - (+ 1 _))) | |
;}}}" | |
(cond ((or (atom (car op-and-args)) (eq (caar op-and-args) 'function)) | |
`(papply-listup-format ,(car op-and-args) ,@(cdr op-and-args))) | |
(t `(papply-form-format ,@op-and-args)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
That's it! I've never noticed that parameter.