/usr/share/common-lisp/source/metabang-bind/dev/bind-cl-ppcre.lisp is in cl-metabang-bind 20141106-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | (in-package #:metabang.bind.developer)
(defmethod bind-generate-bindings
((kind (eql :re)) variable-form value-form
body declarations remaining-bindings)
;; (:re "re" vars)
(bind (((regex &rest vars) variable-form)
(gok (gensym "ok"))
(gblock (gensym "block"))
((:values vars ignores) (bind-fix-nils vars)))
`((let ((,gok nil))
(block ,gblock
(flet ((doit (,@vars)
,@(when ignores `((declare (ignore ,@ignores))))
(return-from ,gblock
(progn ,@(bind-macro-helper
remaining-bindings declarations body)))))
(cl-ppcre:register-groups-bind
,vars (,regex ,(first value-form) :sharedp t)
,(bind-filter-declarations
declarations variable-form)
(setf ,gok t)
(doit ,@vars))
(unless ,gok
(doit ,@(make-list (length vars) :initial-element nil)))))))))
#+(or)
;; simple but doesn't execute inner code if no bindings found
;; which isn't very bind-like
(defmethod bind-generate-bindings
((kind (eql :re)) variable-form value-form
body declarations remaining-bindings)
;; (:re "re" vars)
(bind (((regex &rest vars) variable-form))
`((cl-ppcre:register-groups-bind ,vars (,regex ,(first value-form) :sharedp t)
,(bind-filter-declarations
declarations variable-form)
,@(bind-macro-helper
remaining-bindings declarations body)))))
#+(or)
;; doesn't handle ignores
(defmethod bind-generate-bindings
((kind (eql :re)) variable-form value-form
body declarations remaining-bindings)
;; (:re "re" vars)
(bind (((regex &rest vars) variable-form)
(gok (gensym "ok"))
(gblock (gensym "block")))
`((let ((,gok nil))
(block ,gblock
(flet ((doit (,@vars)
(return-from ,gblock
,@(bind-macro-helper
remaining-bindings declarations body))))
(cl-ppcre:register-groups-bind
,vars (,regex ,(first value-form) :sharedp t)
,(bind-filter-declarations
declarations variable-form)
(setf ,gok t)
(doit ,@vars))
(unless ,gok
(doit ,@(make-list (length vars) :initial-element nil)))))))))
#+(or)
(bind (((:re "(\\w+)\\s+(\\w+)\\s+(\\d{1,2})\\.(\\d{1,2})\\.(\\d{4})"
fname lname date month year) "Frank Zappa 21.12.1940"))
(list fname lname date month year))
#+(or)
(macroexpand-1
'(bind (((:re "(\\w+)\\s+(\\w+)\\s+(\\d{1,2})\\.(\\d{1,2})\\.(\\d{4})"
fname lname date month year) "Frank Zappa 21.12.1940"))
(list fname lname date month year)))
#+(or)
(bind (((:re "(\\w+)\\s+(\\w+)\\s+(\\d{1,2})\\.(\\d{1,2})\\.(\\d{4})"
fname lname nil month year) "Frank Zappa 21.12.1940"))
(list fname lname month year))
#+(or)
(bind (((:re "(a|b)+" first) "cccc"))
(format t "This will still be printed: ~A" first))
|