diff -Nru cl-metabang-bind-20141106/debian/changelog cl-metabang-bind-20170124/debian/changelog --- cl-metabang-bind-20141106/debian/changelog 2014-12-18 15:14:50.000000000 +0000 +++ cl-metabang-bind-20170124/debian/changelog 2017-07-06 13:29:28.000000000 +0000 @@ -1,3 +1,9 @@ +cl-metabang-bind (20170124-1) unstable; urgency=medium + + * Quicklisp release update. + + -- Dimitri Fontaine Thu, 06 Jul 2017 16:29:28 +0300 + cl-metabang-bind (20141106-1) unstable; urgency=medium * Quicklisp release update. diff -Nru cl-metabang-bind-20141106/debian/control cl-metabang-bind-20170124/debian/control --- cl-metabang-bind-20141106/debian/control 2014-08-04 15:25:23.000000000 +0000 +++ cl-metabang-bind-20170124/debian/control 2017-07-06 13:22:48.000000000 +0000 @@ -4,7 +4,7 @@ Maintainer: Dimitri Fontaine Build-Depends: debhelper (>= 7) Build-Depends-Indep: dh-lisp -Standards-Version: 3.9.5 +Standards-Version: 3.9.6 Homepage: http://common-lisp.net/project/metabang-bind/ Vcs-Git: git://github.com/gwkkwg/metabang-bind Vcs-Browser: https://github.com/gwkkwg/metabang-bind diff -Nru cl-metabang-bind-20141106/dev/bind-cl-ppcre.lisp cl-metabang-bind-20170124/dev/bind-cl-ppcre.lisp --- cl-metabang-bind-20141106/dev/bind-cl-ppcre.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/dev/bind-cl-ppcre.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -1,8 +1,7 @@ (in-package #:metabang.bind.developer) -(defmethod bind-generate-bindings - ((kind (eql :re)) variable-form value-form - body declarations remaining-bindings) +#+wrong +(defmethod bind-generate-bindings ((kind (eql :re)) variable-form value-form) ;; (:re "re" vars) (bind (((regex &rest vars) variable-form) (gok (gensym "ok")) @@ -24,19 +23,12 @@ (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) +(defmethod bind-generate-bindings ((kind (eql :regex)) variable-form value-form) ;; (: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))))) + `((cl-ppcre:register-groups-bind ,vars (,regex ,(first value-form) :sharedp t))))) #+(or) ;; doesn't handle ignores diff -Nru cl-metabang-bind-20141106/dev/binding-forms.lisp cl-metabang-bind-20170124/dev/binding-forms.lisp --- cl-metabang-bind-20141106/dev/binding-forms.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/dev/binding-forms.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -1,7 +1,6 @@ (in-package #:metabang.bind) -(defgeneric bind-generate-bindings (kind variable-form value-form - body declarations remaining-bindings) +(defgeneric bind-generate-bindings (kind variable-form value-form) (:documentation "Handle the expansion for a particular binding-form. `kind` specifies the binding form. It can be a type (e.g., symbol or array) @@ -15,13 +14,7 @@ then `kind` will be :values, `variable-form` will be the list `(a b c)` and `value-form` will be the expression `(foo)`. `bind-generate-bindings` -uses these variables as data to construct the generated code. `body` contains -the rest of the code passed to `bind` (the `...`) above in this case) and can -usually be ignored. `declarations` contains all of the declarations from the -`bind` form (e.g. the `optimize (speed 3)` and so on) and should be used to -insert whatever declarations match at this particular point in the expansion. -Use [bind-filter-declarations][] to do this easily). Finally, remaining-bindings -contains the rest of the binding-forms. It can also be safely ignored.")) +uses these variables as data to construct the generated code.")) (defbinding-form (array :use-values-p t) @@ -37,7 +30,7 @@ :use-values-p nil) (if (keywordp kind) (error "Don't have a binding form for ~s" kind) - `(let (,@(if values + `(let* (,@(if values `((,variables ,values)) `(,variables)))))) @@ -169,8 +162,8 @@ `(destructuring-bind ,vars ,values ,@(when ignores `((declare (ignore ,@ignores))))))) -(defbinding-form (:values - :docstring "" +(defbinding-form ((:values :mv-bind :multiple-value-bind) + :docstring "Expands into a multiple-value-bind" :use-values-p nil) (multiple-value-bind (vars ignores) (bind-fix-nils variables) @@ -241,7 +234,7 @@ var)) (var-name (intern (format nil "~a~a" conc-name var-conc) (symbol-package conc-name))) - (type-declaration (find-type-declaration var-var declarations))) + (type-declaration (find-type-declaration var-var *all-declarations*))) `(,var-var ,(if type-declaration `(the ,type-declaration (,var-name ,values)) `(,var-name ,values)))))))) @@ -518,10 +511,9 @@ (bind (((:plist- a (b _) (c _ 2) (dd d)) '(b "B" a "A" d "D"))) (list a b c dd)) - (defbinding-form (:file :use-values-p nil :accept-multiple-forms-p t) - "The binding form for a file is as follows: + "The binding form for a file is as follows: ((:file stream-var) file-name | (file-name arguments*)) diff -Nru cl-metabang-bind-20141106/dev/bind.lisp cl-metabang-bind-20170124/dev/bind.lisp --- cl-metabang-bind-20141106/dev/bind.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/dev/bind.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -6,8 +6,11 @@ |# -(in-package #:metabang.bind) +(in-package #:metabang.bind) +(defconstant +code-marker+ :XXX) +(defconstant +decl-marker+ :YYY) + (defgeneric binding-form-accepts-multiple-forms-p (binding-form) (:documentation "Returns true if a binding form can accept multiple forms (e.g., :flet)")) @@ -21,7 +24,7 @@ The possible options are -* :print-warning (the current default) - print a warning about the problem +* :print-warning (the current default) - print a warning about the problem and signal a `bind-unused-declarations-condition` * :warn - signal a `bind-unused-declarations-warning` warning @@ -29,11 +32,11 @@ * :error - signal a `bind-unused-declarations-error` error") (defparameter *bind-all-declarations* - '(dynamic-extent ignore optimize ftype inline + '(dynamic-extent ignore optimize ftype inline special ignorable notinline type)) (defparameter *bind-non-var-declarations* - '(optimize ftype inline notinline + '(optimize ftype inline notinline #+allegro :explain)) @@ -41,7 +44,7 @@ (remove 'type (set-difference *bind-all-declarations* *bind-non-var-declarations*))) -(defparameter *bind-lambda-list-markers* +(defparameter *bind-lambda-list-markers* '(&key &body &rest &args &optional)) (define-condition simple-style-warning (style-warning simple-warning) @@ -74,7 +77,7 @@ :reader binding))) (define-condition bind-keyword/optional-nil-with-default-error (bind-error) - ((bad-variable + ((bad-variable :initform nil :initarg :bad-variable :reader bad-variable)) @@ -107,14 +110,14 @@ (let ((binding-forms (get 'bind :binding-forms)) (canonical-names (sort - (delete-duplicates + (delete-duplicates (mapcar #'second (get 'bind :binding-forms))) #'string-lessp))) (loop for form in canonical-names collect (cdr (assoc form binding-forms))))) (defun binding-form-synonyms (name) - "Return a list of synonyms for the binding-form `name`. + "Return a list of synonyms for the binding-form `name`. For example @@ -130,18 +133,23 @@ (defvar *all-declarations*) (defmacro bind ((&rest bindings) &body body) - "Bind is a replacement for let*, destructuring-bind, multiple-value-bind and more. + "Bind is a replacement for let*, destructuring-bind, multiple-value-bind and more. An example is probably the best way to describe its syntax: \(bind \(\(a 2\) \(\(b &rest args &key \(c 2\) &allow-other-keys\) '\(:a :c 5 :d 10 :e 54\)\) - \(\(:values d e\) \(truncate 4.5\)\)\) + \(\(:values d e\) \(truncate 4.5\)\) + \(\(:structure xxx- slot1 slot2\) \(make-xxx\)\) + \(\(:flet name \(arg1 arg2\)\) \(+ arg1 arg2\)\)\) \(list a b c d e args\)\) Simple bindings are as in let*. Destructuring is done if the first item in a binding is a list. Multiple value binding is done if the first item -in a binding is a list and the first item in the list is ':values'." +in a binding is a list and the first item in the list is ':values'. Other +forms have their own syntax. For example, :structure first has the conc +name and then slot names whereas :flet has the function name and a list +of arguments and then the function body (in an implicit progn)." (let (declarations) (loop while (and (consp (car body)) (eq (caar body) 'declare)) do (push (first body) declarations) @@ -149,7 +157,7 @@ (if bindings (let ((*all-declarations* (bind-expand-declarations (nreverse declarations)))) (prog1 - (first (bind-macro-helper bindings *all-declarations* body)) + (bind-macro-helper bindings body) (check-for-unused-variable-declarations *all-declarations*))) `(locally ,@declarations @@ -157,17 +165,17 @@ (defun check-for-unused-variable-declarations (declarations) (when declarations - (case *unused-declarations-behavior* + (case *unused-declarations-behavior* (:warn (warn 'bind-unused-declarations-warning :unused-declarations declarations)) (:error (error 'bind-unused-declarations-error :unused-declarations declarations)) (t - (format *error-output* "~&;;; warning: wnused declarations found in form: ~{~s~^, ~}." + (format *error-output* "~&;;; warning: unused declarations found in form: ~{~s~^, ~}." declarations) (signal 'bind-unused-declarations-condition :unused-declarations declarations))))) -(defun bind-macro-helper (bindings declarations body) +(defun bind-macro-helper (bindings body) (if bindings (let ((binding (first bindings)) (remaining-bindings (rest bindings)) @@ -185,28 +193,45 @@ (eq (symbol-package (first variable-form)) (load-time-value (find-package :keyword))) (first variable-form)))) - (when (and (consp value-form) + (when (and (consp value-form) (cdr value-form) (or (null binding-form) (not (binding-form-accepts-multiple-forms-p binding-form)))) - (error 'bind-too-many-value-forms-error + (error 'bind-too-many-value-forms-error :variable-form variable-form :value-form value-form)) - ;;(print (list :vf variable-form :value value-form :a atomp :b binding-form)) - (if binding-form - (bind-generate-bindings - (first variable-form) - (rest variable-form) - value-form body declarations remaining-bindings) - (bind-generate-bindings - variable-form - variable-form - value-form body declarations remaining-bindings))) - body)) + (let* ((body (bind-macro-helper remaining-bindings body)) + (variables (if binding-form (rest variable-form) variable-form)) + (decls (bind-filter-declarations variables))) + (multiple-value-bind (form double-indent) + (if binding-form + ;; e.g., (:values ...) + (bind-generate-bindings (first variable-form) (rest variable-form) value-form) + ;; e.g., #(a b c) + (bind-generate-bindings variable-form variable-form value-form)) + (cond ((or (tree-find form +code-marker+) + (tree-find form +decl-marker+)) + (setf form (subst body +code-marker+ form)) + (setf form (subst decls +decl-marker+ form))) + (double-indent + `(,@(butlast form) (,@(first (last form)) ,@decls ,body))) + ((merge-binding-forms-p form body) + (destructuring-bind (head1 form1-bindings . form1-code) + form + (destructuring-bind (_ form2-bindings . form2-code) + body + (declare (ignore _)) + `(,head1 (,@form1-bindings ,@form2-bindings) + ,@decls + ,@form1-code + ,@form2-code)))) + (t + `(,@form ,@decls ,body)))))) + `(progn ,@body))) ;;;; (defun var-ignorable-p (var) - (or (null var) + (or (null var) (and (symbolp var) (string= (symbol-name var) (symbol-name '_))))) (defun mint-ignorable-variable () @@ -224,26 +249,27 @@ (defun bind-fix-nils-destructured (var-list) (let ((ignores nil)) - (labels (;; adapted from metatilities - (tree-map (fn tree) - "Maps FN over every atom in TREE." - (cond - ;; ((null tree) nil) - ((atom tree) (funcall fn tree)) - (t - (cons - (tree-map fn (car tree)) - (when (cdr tree) (tree-map fn (cdr tree)))))))) - - (values (tree-map - (lambda (x) - (cond ((var-ignorable-p x) - (let ((ignore (mint-ignorable-variable))) - (push ignore ignores) - ignore)) - (t x))) - var-list) - ignores)))) + (flet ((maybe-handle-1 (x) + (if (var-ignorable-p x) + (let ((ignore (mint-ignorable-variable))) + (push ignore ignores) + ignore) + x))) + (labels ((do-it (it key?) + (cond ((null it) + nil) + ((atom it) + (maybe-handle-1 it)) + ((dotted-pair-p it) + (cons (do-it (car it) key?) (do-it (cdr it) key?))) + ((eq (first it) '&key) + (loop for x in it collect (do-it x t))) + (key? + it) + (t + (cons (do-it (car it) key?) + (do-it (cdr it) key?)))))) + (values (do-it var-list nil) ignores))))) (defun dotted-pair-p (putative-pair) "Returns true if and only if `putative-pair` is a dotted-list. I.e., if `putative-pair` is a cons cell with a non-nil cdr." @@ -251,15 +277,22 @@ (cdr putative-pair) (not (consp (cdr putative-pair))))) +(defmethod bind-collect-variables (kind variable-form) + (declare (ignore kind)) + variable-form) + (defun bind-get-vars-from-lambda-list (lambda-list) (let ((result nil)) (labels ((do-it (thing) - (cond ((atom thing) + (cond ((arrayp thing) + (loop for i below (array-total-size thing) + for var = (row-major-aref thing i) do (do-it var))) + ((atom thing) (unless (or (member thing *bind-lambda-list-markers*) - (null thing)) + (var-ignorable-p thing)) (push thing result))) ((dotted-pair-p thing) - (do-it (car thing)) + (do-it (car thing)) (do-it (cdr thing))) (t (do-it (car thing)) @@ -267,11 +300,6 @@ (do-it lambda-list)) (nreverse result))) -#+(or) -(loop for item in lambda-list - unless (member item *bind-lambda-list-markers*) collect - (if (consp item) (first item) item)) - (defun bind-expand-declarations (declarations) (loop for declaration in declarations append (loop for decl in (rest declaration) append @@ -287,17 +315,17 @@ (loop for var in (rest decl) collect `(type ,(first decl) ,var))))))) -(defun bind-filter-declarations (declarations var-names) - (setf var-names (if (consp var-names) var-names (list var-names))) +(defun bind-filter-declarations (var-names) + (setf var-names (if (consp var-names) var-names (list var-names))) (setf var-names (bind-get-vars-from-lambda-list var-names)) ;; each declaration is separate (let ((declaration - (loop for declaration in declarations + (loop for declaration in *all-declarations* when (or (member (first declaration) *bind-non-var-declarations*) (and (member (first declaration) *bind-simple-var-declarations*) - (member + (member (if (atom (second declaration)) (second declaration) ;; ... (function foo) ...) @@ -308,13 +336,39 @@ (progn (setf *all-declarations* (remove declaration *all-declarations*)) declaration)))) - (when declaration + (when declaration `((declare ,@declaration))))) +(defun merge-binding-forms-p (form1 form2) + (and (consp form1) (consp form2) + (let ((tag1 (first form1)) + (tag2 (first form2))) + (and (symbolp tag1) + (symbolp tag2) + (string-equal (symbol-name tag1) (symbol-name tag2)) + (or (string-equal (symbol-name tag1) "let") + (string-equal (symbol-name tag1) "let*") + (string-equal (symbol-name tag1) "labels")))))) + +(defun map-tree (fn object) + "apply `fn` to every leaf of `object`." + (cond ((consp object) + (map-tree fn (car object)) + (map-tree fn (cdr object))) + (object + (funcall fn object)))) + +(defun tree-find (tree it &key (test #'eq) (key #'identity)) + (flet ((isit (atom) + (when key (setf atom (funcall key atom))) + (when (funcall test it atom) (return-from tree-find t)))) + (declare (dynamic-extent #'isit)) + (map-tree #'isit tree))) + ;;; fluid-bind (defmacro fluid-bind ((&rest bindings) &body body) - "Fluid-bind is an extension of bind that handles setting and resetting places. For example, suppose that an object of class foo has a slot named bar whose value is currently 3. The following code would evaluate the inner body with bar bound to 17 and restore it when the inner body is exited. + "Fluid-bind is an extension of bind that handles setting and resetting places. For example, suppose that an object of class foo has a slot named bar whose value is currently 3. The following code would evaluate the inner body with bar bound to 17 and restore it when the inner body is exited. \(fluid-bind \(\(\(bar foo\) 17\)\) \(print \(bar foo\)\)\) @@ -327,7 +381,7 @@ (cleanup-forms nil) (gensyms nil)) (loop for binding in bindings collect - (destructuring-bind + (destructuring-bind (setup-form cleanup-form) (cond ((consp binding) (destructuring-bind (var value) binding @@ -396,8 +450,8 @@ (bind ((a 3)) (list *last-world* *foo* a))) (setf *foo #:2))) - (set *last-world* #:g1)) - + (set *last-world* #:g1)) + (fluid-bind (a b) (+ a a)) |# diff -Nru cl-metabang-bind-20141106/dev/bind-re-allegro.lisp cl-metabang-bind-20170124/dev/bind-re-allegro.lisp --- cl-metabang-bind-20141106/dev/bind-re-allegro.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/dev/bind-re-allegro.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -1,31 +1,33 @@ (in-package #:metabang.bind.developer) -(defmethod bind-generate-bindings - ((kind (eql :re)) variable-form value-form - body declarations remaining-bindings) +(defmethod bind-generate-bindings ((kind (eql :re)) variable-form value-form) ;; (: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)) + `(let* ((,gok nil)) (block ,gblock (flet ((doit (,@vars) ,@(when ignores `((declare (ignore ,@ignores)))) - (return-from ,gblock - (progn ,@(bind-macro-helper - remaining-bindings declarations body))))) + ,metabang-bind::+decl-marker+ + (return-from ,gblock ,metabang-bind::+code-marker+))) (excl:re-let ,regex ,(first value-form) ,(loop for var in vars for i from 1 collect `(,var ,i)) - ,(bind-filter-declarations - declarations variable-form) (setf ,gok t) (doit ,@vars)) (unless ,gok - (doit ,@(make-list (length vars) :initial-element nil))))))))) + (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)) + +(defmethod bind-generate-bindings ((kind (eql :regex)) variable-form value-form) + ;; (:regex "re" vars) + (bind (((regex &rest vars) variable-form)) + `(excl:re-let ,regex ,(first value-form) + ,(loop for var in vars for i from 1 collect + `(,var ,i))))) diff -Nru cl-metabang-bind-20141106/dev/macros.lisp cl-metabang-bind-20170124/dev/macros.lisp --- cl-metabang-bind-20141106/dev/macros.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/dev/macros.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -69,28 +69,25 @@ (let* ((multiple-names? (consp name/s)) (main-method-name nil) (force-keyword? (or multiple-names? - (eq (symbol-package name/s) + (eq (symbol-package name/s) (load-time-value (find-package :keyword))))) - #+(or) - (gignores (gensym "ignores"))) + (gnew-form (gensym "new-form"))) (cond (multiple-names? - (setf main-method-name (gentemp (symbol-name '#:binding-generator))) - ) + (setf main-method-name (gensym (symbol-name '#:binding-generator)))) (t - (setf main-method-name 'bind-generate-bindings) - )) + (setf main-method-name 'bind-generate-bindings))) (flet ((form-keyword (name) (intern (symbol-name name) (load-time-value (find-package :keyword))))) (when force-keyword? - (setf name/s (if multiple-names? + (setf name/s (if multiple-names? (mapcar #'form-keyword name/s) (form-keyword name/s)))) `(progn (setf (binding-form-docstring ',name/s) ,docstring) - ,@(loop for name in (if multiple-names? name/s (list name/s)) + ,@(loop for name in (if multiple-names? name/s (list name/s)) when (keywordp name) collect - `(defmethod binding-form-accepts-multiple-forms-p + `(defmethod binding-form-accepts-multiple-forms-p ((binding-form (eql ,name))) ,accept-multiple-forms-p)) (,(if multiple-names? 'defun 'defmethod) ,main-method-name @@ -98,56 +95,40 @@ (if force-keyword? `((kind (eql ,name/s))) `((kind ,name/s)))) - variable-form value-form body declarations remaining-bindings) + variable-form value-form) + ;;?? Can (symbolp (first body)) ever be true? ,(if use-values-p - ;; surely this could be simpler! - `(let ((gvalues (next-value "values-"))) - `((let ((,gvalues ,,(if accept-multiple-forms-p - `value-form - `(first value-form)))) - (declare (ignorable ,gvalues)) - (,@,(if (symbolp (first body)) - `(,(first body) variable-form gvalues) - `(funcall (lambda (variables values) ,@body) - variable-form gvalues)) - ; ,@(when ,gignores `((declare (ignore ,@gignores)))) - ,@(bind-filter-declarations - declarations variable-form) - ,@(bind-macro-helper - remaining-bindings declarations body))))) - ``((,@,(if (symbolp (first body)) - `(,(first body) variable-form ,(if accept-multiple-forms-p - `value-form - `(first value-form))) - `(funcall (lambda (variables values) ,@body) - variable-form ,(if accept-multiple-forms-p + `(let* ((gvalues (next-value "values-")) + (,gnew-form (funcall (lambda (variables values) ,@body) + variable-form gvalues))) + (destructuring-bind (TAG . REST) + ,gnew-form + ;;?? CASE + (if (or (eq TAG 'let) (eq TAG 'let*)) + (destructuring-bind (let-bindings . after-bindings) + REST + (values `(let* ((,gvalues ,,(if accept-multiple-forms-p + `value-form + `(first value-form))) + ,@let-bindings) + (declare (ignorable ,gvalues)) + ,@after-bindings) + nil)) + (values `(let* ((,gvalues ,,(if accept-multiple-forms-p `value-form `(first value-form)))) - ,@(bind-filter-declarations declarations variable-form) - ,@(bind-macro-helper - remaining-bindings declarations body))))) + (declare (ignorable ,gvalues)) + ,,gnew-form) + t)))) + `(let ((,gnew-form (funcall (lambda (variables values) ,@body) + variable-form ,(if accept-multiple-forms-p + `value-form + `(first value-form))))) + (values ,gnew-form nil)))) ,@(when multiple-names? (loop for name in name/s collect - `(defmethod bind-generate-bindings - ((kind (eql ,name)) - variable-form value-form body declarations - remaining-bindings) - (,main-method-name - variable-form value-form body declarations - remaining-bindings)))) - #+(or) - ,@(when multiple-names? - (loop for name in name/s collect - `(defmethod bind-generate-bindings - ((kind (eql ,name)) - variable-form value-form body declarations - remaining-bindings) - (,main-method-name - variable-form - ,(if accept-multiple-forms-p `value-form `(first value-form)) - body declarations - remaining-bindings)))) - )))) + `(defmethod bind-generate-bindings ((kind (eql ,name)) variable-form value-form) + (,main-method-name variable-form value-form)))))))) (defun next-value (x) (gensym x)) diff -Nru cl-metabang-bind-20141106/unit-tests/functions.lisp cl-metabang-bind-20170124/unit-tests/functions.lisp --- cl-metabang-bind-20141106/unit-tests/functions.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/unit-tests/functions.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -33,7 +33,7 @@ (ensure-same (doit 2) 7))) (addtest (test-flet) - docstring-and-declarations + docstring-and-declarations-1 (bind (((:flet doit (x)) "whatever" (declare (type fixnum x)) @@ -44,7 +44,7 @@ (ensure-same (doit 2) 7))) (addtest (test-flet) - docstring-and-declarations + docstring-and-declarations-2 (bind (((:flet constant (x)) (declare (ignore x)) 42)) @@ -85,7 +85,7 @@ (ensure-same (doit 2) 7))) (addtest (test-labels) - docstring-and-declarations + docstring-and-declarations-1 (bind (((:labels doit (x)) "whatever" (declare (type fixnum x)) @@ -96,7 +96,7 @@ (ensure-same (doit 2) 7))) (addtest (test-labels) - docstring-and-declarations + docstring-and-declarations-2 (bind (((:labels constant (x)) (declare (ignore x)) 42)) diff -Nru cl-metabang-bind-20141106/unit-tests/test-bind.lisp cl-metabang-bind-20170124/unit-tests/test-bind.lisp --- cl-metabang-bind-20141106/unit-tests/test-bind.lisp 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/unit-tests/test-bind.lisp 2017-01-01 19:30:53.000000000 +0000 @@ -77,6 +77,14 @@ (ensure-same (fifth vars) (first ignores)) (ensure-same (fourth vars) '(c 1) :test 'equal))) +(addtest (test-bind-fix-nils-destructured) + keyword-list-with-nil-default + (multiple-value-bind (vars ignores) + (bind-fix-nils-destructured '(a b &key (c nil c?))) + (ensure-same (length ignores) 0) + (ensure-same (subseq vars 0 3) '(a b &key) :test #'equal) + (ensure-same (fourth vars) '(c nil c?) :test 'equal))) + #+Ignore ;;?? not yet (addtest (test-bind-fix-nils-destructured) diff -Nru cl-metabang-bind-20141106/website/source/images/index.mmd cl-metabang-bind-20170124/website/source/images/index.mmd --- cl-metabang-bind-20141106/website/source/images/index.mmd 1970-01-01 00:00:00.000000000 +0000 +++ cl-metabang-bind-20170124/website/source/images/index.mmd 2017-01-01 19:30:53.000000000 +0000 @@ -0,0 +1,89 @@ +{include header.md} +{set-property title "metabang-bind - Sticking it the to metal..."} + +
+
+ + * [User's guide](user-guide.html) + * [Issue's tracker](https://github.com/gwkkwg/metabang-bind/issues) + * [Mailing Lists][3] + * [Getting it][4] + * [News][6] + * [Changelog][7] + + [3]: #mailing-lists + [4]: #downloads + [5]: documentation/ (documentation link) + [6]: #news + [7]: changelog.html + + +
+
+ +### What it is + +Bind extends the idea of of `let` and destructing to provide +a uniform syntax for all your accessor needs. It combines +_let_, _destructuring-bind_, `with-slots`, `with-accessors`, +structure editing, property or association-lists, and +_multiple-value-bind_ and a whole lot more into a single +form. The [user guide][user-guide] has all the details but +here is example to whet your appetite: + + (bind ((a 2) + ((b &rest args &key (c 2) &allow-other-keys) '(:a :c 5 :d 10 :e 54)) + ((:values d e) (truncate 4.5))) + (list a b c d e args)) + ==> (2 :A 5 4 0.5 (:C 5 :D 10 :E 54)) + +Bind is especially handy when you have more than one layer of +`multiple-value-bind` or `destructuring-bind`. Since `bind` is a +single form, you don't end up too far off to the right in +editor land. + +Bind is released under the [MIT license][mit-license]. + +{anchor mailing-lists} + +### Mailing Lists + +Use the developer [mailing list][metabang-bind-devel] for any questions or comments regarding bind. + +{anchor downloads} + +### Where is it + +metabang.com is switching from [darcs][] to [git][] for source control; the current metabang-bind repository is on [github][github-metabang-bind] and you can clone it using: + + git clone git://github.com/gwkkwg/metabang-bind + +metabang-bind is also [ASDF installable][asdf-install]. Its +CLiki home is right [where][cliki-home] you'd expect. + +There's also a handy [gzipped tar file][tarball]. + +{anchor news} + +### What is happening + +10 April 2010 - moved to github; added flet support + +28 May 2009 - added `:structure/rw` binding form; updated +webpage to link to the user's guide + +1 Dec 2007 - Added support for [array +destructuring][array-bindings] (Thanks to Tamas Papp for the +idea) + +15 Nov 2007 - New user guide; bind handles structures and +property lists and is now extensible! + +13 Nov 2005 - Initial webpage n' stuff. + +
+
+ +{include footer.md} + + diff -Nru cl-metabang-bind-20141106/website/source/user-guide.mmd cl-metabang-bind-20170124/website/source/user-guide.mmd --- cl-metabang-bind-20141106/website/source/user-guide.mmd 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/website/source/user-guide.mmd 2017-01-01 19:30:53.000000000 +0000 @@ -50,11 +50,11 @@ Bind mimics let in its general syntax: (bind (&rest bindings) ) - + where each `binding` can either be an symbol or a list. If the binding is an atom, then this atom will be bound to nil within the body (just as in let). If it is a list, then it will be interpreted depending on its first form. (bind (a - (...)) + (...)) ...) ### Bind as a replacement for let @@ -84,11 +84,11 @@ (list a b c d)) => (1 2 3 4) -Note that `bind` makes it a little easier to ignore variables you don't care about. -Suppose I've got a function `ijara` that returns 3 values and I happen to need only +Note that `bind` makes it a little easier to ignore variables you don't care about. +Suppose I've got a function `ijara` that returns 3 values and I happen to need only the second two. Using `destructuring-bind`, I'd write: - (destructuring-bind (foo value-1 value-2) + (destructuring-bind (foo value-1 value-2) (ijira) (declare (ignore foo)) ...) @@ -117,24 +117,24 @@ (fuzz (getf plist :fuzziness 'no))) (list start end fuzz)) => (368421722 368494926 no) - + The binding form for property-lists is as follows: (:plist property-spec*) - + where each property-spec is an atom or a list of up to three elements: * atoms bind a variable with that name to -a property with the same name (converting the name to a keyword in order to do the lookup). +a property with the same name (converting the name to a keyword in order to do the lookup). * lists with a single element are treated like atoms. * lists with two elements specify the variable in the first and the name of the -property in the second. +property in the second. * Lists with three elements use -the third element to specify a default value (if the +the third element to specify a default value (if the second element is #\_, then the property name is taken to be the same as the variable name). @@ -161,7 +161,7 @@ * an atom specifies both the name of the variable to which the structure field is bound and the field-name in the structure. -* a list has the variable name as its first item and the structure field name as its second. +* a list has the variable name as its first item and the structure field name as its second. So if we have a structure like: @@ -185,23 +185,23 @@ (:slots slot-spec*) (:accessors accessor-spec*) - + Where both slot-spec and accessor-spec can be atoms or lists with two elements. * an atom tells bind to use it as the name of the new variable _and_ to treat this name as the name of the slot or the name of the accessor, respectively. -* If the specification is a list, then bind will use the first item as the variable's name and the second item as the slot-name or accessor. +* If the specification is a list, then bind will use the first item as the variable's name and the second item as the slot-name or accessor. Support we had a class like: (defclass wicked-cool-class () ((a :initarg :a :accessor its-a) - (b :initarg :b :accessor b) + (b :initarg :b :accessor b) (c :initarg :c :accessor just-c))) If we don't mind using the slot-names as variable names, then we can use the simplest form of `:slots`: - (bind (((:slots a b c) + (bind (((:slots a b c) (make-instance 'wicked-cool-class :a 1 :b 2 :c 3))) (list a b c)) @@ -209,7 +209,7 @@ We can also change the names within the context of our bind form: - (bind (((:slots a b (dance-count c)) + (bind (((:slots a b (dance-count c)) (make-instance 'wicked-cool-class :a 1 :b 2 :c 3))) (list a b dance-count)) @@ -217,7 +217,7 @@ Similarly, we can use `:accessors` with variable names that are the same as the accessor names... - (bind (((:accessors its-a b just-c) + (bind (((:accessors its-a b just-c) (make-instance 'wicked-cool-class :a 1 :b 2 :c 3))) (list its-a b just-c)) @@ -225,7 +225,7 @@ or that are different: - (bind (((:accessors (a its-a) b (c just-c)) + (bind (((:accessors (a its-a) b (c just-c)) (make-instance 'wicked-cool-class :a 1 :b 2 :c 3))) (list a b c)) @@ -235,7 +235,7 @@ ### Bind with arrays -Tamas Papp had the idea of letting `bind` handle arrays too. For example, +Tamas Papp had the idea of letting `bind` handle arrays too. For example, (bind ((#(a b c) #(1 2 3))) (list a b c)) @@ -250,7 +250,7 @@ (:re expression &rest vars) string) -and will bind each grouped item in the expression to the +and will bind each grouped item in the expression to the corresponding var. For example: (bind (((:re "(\\w+)\\s+(\\w+)\\s+(\\d{1,2})\\.(\\d{1,2})\\.(\\d{4})" @@ -262,8 +262,8 @@ ### Bind with `flet` and `labels` -Bind can even be used as a replacement for `flet` and `labels`. -The syntax is +Bind can even be used as a replacement for `flet` and `labels`. +The syntax is (:flet function-name (arguments*)) definition) @@ -283,15 +283,15 @@ ==> t Note that bind currently expands each binding-form into a new context. In -particular, this means that +particular, this means that (bind (((:flet x (a)) (* a 2)) ((:flet y (b)) (+ b 2))) ...) -expands as +expands as - (flet ((x (a) (progn (* a 2)))) + (flet ((x (a) (progn (* a 2)))) (flet ((y (b) (progn (+ b 2)))) ...)) @@ -306,7 +306,7 @@ ## `bind` and declarations `bind` handles declarations transparently by splitting them -up and moving them to the correct place in the expansion. For +up and moving them to the correct place in the expansion. For example (bind (((:values a b) (foo x)) @@ -316,7 +316,7 @@ (list a b d e)) becomes - + (multiple-value-bind (a b) (foo x) (declare (type fixnum a) (optimize (speed 3))) @@ -326,9 +326,9 @@ (declare (optimize (speed 3))) (list a b d e)))) -because `bind` knows to keep the variable declarations -(like `type`) with their variables and to repeat -other declarations (like `optimize`) at each level. +because `bind` knows to keep the variable declarations +(like `type`) with their variables and to repeat +other declarations (like `optimize`) at each level. `bind` keeps track of variables declarations that are not used. The configuration variable `*unused-declarations-behavior*` controls diff -Nru cl-metabang-bind-20141106/website/website.tmproj cl-metabang-bind-20170124/website/website.tmproj --- cl-metabang-bind-20141106/website/website.tmproj 2014-10-06 15:07:44.000000000 +0000 +++ cl-metabang-bind-20170124/website/website.tmproj 1970-01-01 00:00:00.000000000 +0000 @@ -1,265 +0,0 @@ - - - - - currentDocument - source/resources/footer.md - documents - - - expanded - - name - images - regexFolderFilter - !.*/(\.[^/]*|CVS|_darcs|_MTN|\{arch\}|blib|.*~\.nib|.*\.(framework|app|pbproj|pbxproj|xcode(proj)?|bundle))$ - sourceDirectory - source/images - - - expanded - - name - resources - regexFolderFilter - !.*/(\.[^/]*|CVS|_darcs|_MTN|\{arch\}|blib|.*~\.nib|.*\.(framework|app|pbproj|pbxproj|xcode(proj)?|bundle))$ - sourceDirectory - source/resources - - - filename - source/user-guide.css - lastUsed - 2011-02-12T16:05:38Z - - - filename - source/user-guide.mmd - lastUsed - 2011-04-05T16:58:22Z - - - filename - ../../shared/shared-links.md - lastUsed - 2010-04-10T15:11:40Z - - - filename - source/index.mmd - lastUsed - 2011-04-05T16:59:24Z - - - fileHierarchyDrawerWidth - 200 - metaData - - ../../shared/shared-links.md - - caret - - column - 9 - line - 68 - - firstVisibleColumn - 0 - firstVisibleLine - 39 - - source/index.mmd - - caret - - column - 10 - line - 7 - - firstVisibleColumn - 0 - firstVisibleLine - 0 - - source/resources/footer.md - - caret - - column - 37 - line - 8 - - firstVisibleColumn - 0 - firstVisibleLine - 0 - - source/resources/guide-footer.md - - caret - - column - 0 - line - 6 - - columnSelection - - firstVisibleColumn - 0 - firstVisibleLine - 0 - selectFrom - - column - 0 - line - 0 - - selectTo - - column - 0 - line - 6 - - - source/resources/guide-header.md - - caret - - column - 0 - line - 9 - - columnSelection - - firstVisibleColumn - 0 - firstVisibleLine - 0 - selectFrom - - column - 0 - line - 0 - - selectTo - - column - 0 - line - 9 - - - source/resources/header.md - - caret - - column - 0 - line - 2 - - columnSelection - - firstVisibleColumn - 0 - firstVisibleLine - 0 - selectFrom - - column - 0 - line - 1 - - selectTo - - column - 0 - line - 2 - - - source/resources/navigation.md - - caret - - column - 0 - line - 3 - - firstVisibleColumn - 0 - firstVisibleLine - 0 - - source/resources/shared.md - - caret - - column - 15 - line - 5 - - firstVisibleColumn - 0 - firstVisibleLine - 0 - - source/user-guide.css - - caret - - column - 0 - line - 0 - - firstVisibleColumn - 0 - firstVisibleLine - 0 - - source/user-guide.mmd - - caret - - column - 0 - line - 307 - - firstVisibleColumn - 0 - firstVisibleLine - 276 - - - openDocuments - - source/resources/guide-footer.md - source/user-guide.mmd - source/index.mmd - source/resources/header.md - source/user-guide.css - source/resources/footer.md - source/resources/shared.md - source/resources/guide-header.md - source/resources/navigation.md - ../../shared/shared-links.md - - showFileHierarchyDrawer - - windowFrame - {{76, 32}, {578, 746}} - -