![Макросы чтения
(set-dispatch-macro-character ## #/
(lambda (stream char arg)
(let ((pattern (coerce
(loop
for ch = (read-char stream t nil t)
until (eql ch #/)
collect ch)
'string)))
`(lambda (&rest args)
(apply #'cl-ppcre:scan ,pattern args)))))
(#/[a-z]+/ str)
((lambda (&rest args)
(apply #'cl-ppcre:scan "[a-z]+" args)) str)
(cl-ppcre:scan "[a-z]+" str)](https://image.slidesharecdn.com/cl-metaprogramming-110123041710-phpapp02/85/CL-metaprogramming-9-320.jpg)
CL metaprogramming
- 1. Метапрограммирование в CL "Lisp isn't a language, it's a building material." - Alan Kay ● Макросы ● Макросы чтения ● Макросы компилятора ● ...
- 2. Квазицитирование (defmacro nif (expr positive zero negative) (let ((var (gensym))) `(let ((,var ,expr)) (cond ((plusp ,var) ,positive) ((zerop ,var) ,zero) (t ,negative))))) (nif (- (* b b) (* 4 a c)) 2 1 0) (LET ((#:G624 (- (* B B) (* 4 A C)))) (COND ((PLUSP #:G624) 2) ((ZEROP #:G624) 1) (T 0)))
- 3. Анафорические макросы (defmacro aif (condition then &optional else) `(let ((it ,condition)) (if it ,then ,else))) (aif (load-data)) (pprint it) (print "No data loaded.")) awhen, awhile, aand, alambda... (aand (load-data) (take-field it) (do-smth it))
- 4. Декораторы (defmacro defun/decorated ((&rest decorator) name (&rest params) &body body) `(defun ,name (,@params) (,@decorator (lambda () ,@body) ,@params))) (defun decorator (x f &rest params) (format t "decorator ~A ~{~A ~}" x params) (funcall f)) (defun/decorated (decorator "smth") square (x) (* x x))
- 5. Макросы пишут макросы: TCO (defun fact (n acc) (if (zerop n) acc (fact (- n 1) (* n acc)))) (defmacro defun/tco (name (&rest params) &body body) `(defun ,name (,@params) (macrolet ((,name (&rest args) `(progn (psetq ,@(mapcan (lambda (p v) (list p v)) ',params args)) (go :label)))) (tagbody :label (return-from ,name (progn ,@body)))))) (defun/tco fact/tco (n acc) (if (zerop n) acc (fact/tco (- n 1) (* n acc))))
- 6. EDSL ● CLOS (Common Lisp Object System) ● ITERATE (iter (for i from 1) (for a in some-list) (collect (cons i a))) ● ContextL (AOP) ● Chtml-matcher (<tbody nil (tr nil (<a ((name ?post-num))) (tr nil) (tr nil (?post-body <div ((id "post_message_?"))))))
- 7. Макросы чтения (set-dispatch-macro-character ## #$ #'(lambda (stream char arg) (parse-integer (coerce (loop for ch = (peek-char nil stream nil nil t) while (or (digit-char-p ch) (eql ch #_)) do (read-char stream t nil t) if (digit-char-p ch) collect ch) 'string)))) #$1_000_000
- 8. Макросы чтения (let ((foo 1)) #Uhttp://www.example.com/widget/{foo}/parts) "http://www.example.com/widget/1/parts" (uri-template-bind (#Uhttp://www.example.com/{part}/{number}) "http://www.example.com/widget/1" (list part (parse-integer number) %uri-host)) ("widget" 1 "www.example.com")
- 9. Макросы чтения (set-dispatch-macro-character ## #/ (lambda (stream char arg) (let ((pattern (coerce (loop for ch = (read-char stream t nil t) until (eql ch #/) collect ch) 'string))) `(lambda (&rest args) (apply #'cl-ppcre:scan ,pattern args))))) (#/[a-z]+/ str) ((lambda (&rest args) (apply #'cl-ppcre:scan "[a-z]+" args)) str) (cl-ppcre:scan "[a-z]+" str)
- 10. Макросы компилятора (format stream control-string arg1...) (funcall (formatter control-string) stream arg1 ...) (lambda (stream &rest arguments) (apply #'format stream control-string arguments)) (formatter "Hello, ~A") (LAMBDA (STREAM #:FORMAT-ARG633) (WRITE-STRING "Hello, " STREAM) (PRINC #:FORMAT-ARG633 STREAM)) (formatter "~{~A~%~}") (LAMBDA (STREAM #:FORMAT-ARG636) (LET ((ARGS #:FORMAT-ARG636)) (LOOP (WHEN (NULL ARGS) (RETURN)) (PRINC (POP ARGS) STREAM) (TERPRI STREAM))))
- 11. Макросы компилятора CL-PPCRE (define-compiler-macro scan (&whole form &environment env regex target-string &rest rest) (cond ((constantp regex env) `(scan (load-time-value (create-scanner ,regex)) ,target-string ,@rest)) (t form)))
- 12. Ссылки ● Paul Graham «On Lisp» http://www.paulgraham.com/onlisp.html ● Doug Hoyte «LOL» http://letoverlambda.com/ ● CL-PPCRE http://weitz.de/cl-ppcre/ ● Iterate http://common-lisp.net/project/iterate/ ● ContextL http://common-lisp.net/project/closer/contextl.html ● chtml-matcher http://common-lisp.net/project/chtml-matcher/ ● uri-template http://common-lisp.net/project/uri-template/