annotate lisp/backquote.el @ 5353:38e24b8be4ea

Improve the lexical scoping in #'block, #'return-from. lisp/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (byte-compile-initial-macro-environment): Shadow `block', `return-from' here, we implement them differently when byte-compiling. * bytecomp.el (byte-compile-active-blocks): New. * bytecomp.el (byte-compile-block-1): New. * bytecomp.el (byte-compile-return-from-1): New. * bytecomp.el (return-from-1): New. * bytecomp.el (block-1): New. These are two aliases that exist to have their own associated byte-compile functions, which functions implement `block' and `return-from'. * cl-extra.el (cl-macroexpand-all): Fix a bug here when macros in the environment have been compiled. * cl-macs.el (block): * cl-macs.el (return): * cl-macs.el (return-from): Be more careful about lexical scope in these macros. * cl.el: * cl.el ('cl-block-wrapper): Removed. * cl.el ('cl-block-throw): Removed. These aren't needed in code generated by this XEmacs. They shouldn't be needed in code generated by XEmacs 21.4, but if it turns out the packages do need them, we can put them back. 2011-01-30 Mike Sperber <mike@xemacs.org> * font-lock.el (font-lock-fontify-pending-extents): Don't fail if `font-lock-mode' is unset, which can happen in the middle of `revert-buffer'. 2011-01-23 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete): * cl-macs.el (delq): * cl-macs.el (remove): * cl-macs.el (remq): Don't use the compiler macro if these functions were given the wrong number of arguments, as happens in lisp-tests.el. * cl-seq.el (remove, remq): Removed. I added these to subr.el, and forgot to remove them from here. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-setq, byte-compile-set): Remove kludge allowing keywords' values to be set, all the code that does that is gone. * cl-compat.el (elt-satisfies-test-p): * faces.el (set-face-parent): * faces.el (face-doc-string): * gtk-font-menu.el: * gtk-font-menu.el (gtk-reset-device-font-menus): * msw-font-menu.el: * msw-font-menu.el (mswindows-reset-device-font-menus): * package-get.el (package-get-installedp): * select.el (select-convert-from-image-data): * sound.el: * sound.el (load-sound-file): * x-font-menu.el (x-reset-device-font-menus-core): Don't quote keywords, they're self-quoting, and the win from backward-compatibility is sufficiently small now that the style problem overrides it. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (block, return-from): Require that NAME be a symbol in these macros, as always documented in the #'block docstring and as required by Common Lisp. * descr-text.el (unidata-initialize-unihan-database): Correct the use of non-symbols in #'block and #'return-from in this function. 2011-01-15 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (concatenate): Accept more complicated TYPEs in this function, handing the sequences over to #'coerce if we don't understand them here. * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its compiler macro is more useful than doing that. 2011-01-11 Aidan Kehoe <kehoea@parhasard.net> * subr.el (delete, delq, remove, remq): Move #'remove, #'remq here, they don't belong in cl-seq.el; move #'delete, #'delq here from fns.c, implement them in terms of #'delete*, allowing support for sequences generally. * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq here, now the latter's no longer dumped. * cl-macs.el (delete, delq): Add compiler macros transforming #'delete and #'delq to #'delete* calls. 2011-01-10 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se ! 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): * list-mode.el (display-completion-list): These functions used to use cl-parsing-keywords; change them to use defun* instead, fixing the build. (Not sure what led to me not including this change in d1b17a33450b!) 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (define-star-compiler-macros): Make sure the form has ITEM and LIST specified before attempting to change to calls with explicit tests; necessary for some tests in lisp-tests.el to compile correctly. (stable-union, stable-intersection): Add compiler macros for these functions, in the same way we do for most of the other functions in cl-seq.el. 2011-01-01 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (dolist, dotimes, do-symbols, macrolet) (symbol-macrolet): Define these macros with defmacro* instead of parsing the argument list by hand, for the sake of style and readability; use backquote where appropriate, instead of calling #'list and and friends, for the same reason. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * x-misc.el (device-x-display): Provide this function, documented in the Lispref for years, but not existing previously. Thank you Julian Bradfield, thank you Jeff Mincy. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * simple.el (assoc-ignore-case): Remove a duplicate definition of this function (it's already in subr.el). * iso8859-1.el (char-width): On non-Mule, make this function equivalent to that produced by (constantly 1), but preserve its docstring. * subr.el (subst-char-in-string): Define this in terms of #'substitute, #'nsubstitute. (string-width): Define this using #'reduce and #'char-width. (char-width): Give this a simpler definition, it makes far more sense to check for mule at load time and redefine, as we do in iso8859-1.el. (store-substring): Implement this in terms of #'replace, now #'replace is cheap. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * update-elc.el (lisp-files-needed-for-byte-compilation) (lisp-files-needing-early-byte-compilation): cl-macs belongs in the former, not the latter, it is as fundamental as bytecomp.el. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl.el: Provde the Common Lisp program-error, type-error as error symbols. This doesn't nearly go far enough for anyone using the Common Lisp errors. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-duplicates): If the form has an incorrect number of arguments, don't attempt a compiler macroexpansion. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-safe-expr-p): Forms that start with the symbol lambda are also safe. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): For these functions' compiler macros, the optimisation is safe even if the first and the last arguments have side effects, since they're only used the once. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (inline-side-effect-free-compiler-macros): Unroll a loop here at macro-expansion time, so these compiler macros are compiled. Use #'eql instead of #'eq in a couple of places for better style. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (notany, notevery): Avoid some dynamic scope stupidity with local variable names in these functions, when they weren't prefixed with cl-; go into some more detail in the doc strings. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): #'remove, #'remq are free of side-effects. (side-effect-and-error-free-fns): Drop dot, dot-marker from the list. 2010-11-17 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (coerce): In the argument list, name the first argument OBJECT, not X; the former name was always used in the doc string and is clearer. Handle vector type specifications which include the length of the target sequence, error if there's a mismatch. * cl-macs.el (cl-make-type-test): Handle type specifications starting with the symbol 'eql. 2010-11-14 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (eql): Don't remove the byte-compile property of this symbol. That was necessary to override a bug in bytecomp.el where #'eql was confused with #'eq, which bug we no longer have. If neither expression is constant, don't attempt to handle the expression in this compiler macro, leave it to byte-compile-eql, which produces better code anyway. * bytecomp.el (eq): #'eql is not the function associated with the byte-eq byte code. (byte-compile-eql): Add an explicit compile method for this function, for cases where the cl-macs compiler macro hasn't reduced it to #'eq or #'equal. 2010-10-25 Aidan Kehoe <kehoea@parhasard.net> Add compiler macros and compilation sanity-checking for various functions that take keywords. * byte-optimize.el (side-effect-free-fns): #'symbol-value is side-effect free and not error free. * bytecomp.el (byte-compile-normal-call): Check keyword argument lists for sanity; store information about the positions where keyword arguments start using the new byte-compile-keyword-start property. * cl-macs.el (cl-const-expr-val): Take a new optional argument, cl-not-constant, defaulting to nil, in this function; return it if the expression is not constant. (cl-non-fixnum-number-p): Make this into a separate function, we want to pass it to #'every. (eql): Use it. (define-star-compiler-macros): Use the same code to generate the member*, assoc* and rassoc* compiler macros; special-case some code in #'add-to-list in subr.el. (remove, remq): Add compiler macros for these two functions, in preparation for #'remove being in C. (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to (remove ... :if-not) at compile time, which will be a real win once the latter is in C. (define-substitute-if-compiler-macros) (define-subst-if-compiler-macros): Similarly for these functions. (delete-duplicates): Change this compiler macro to use #'plists-equal; if we don't have information about the type of SEQUENCE at compile time, don't bother attempting to inline the call, the function will be in C soon enough. (equalp): Remove an old commented-out compiler macro for this, if we want to see it it's in version control. (subst-char-in-string): Transform this to a call to nsubstitute or nsubstitute, if that is appropriate. * cl.el (ldiff): Don't call setf here, this makes for a load-time dependency problem in cl-macs.el 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * term/vt100.el: Refer to XEmacs, not GNU Emacs, in permissions. * term/bg-mouse.el: * term/sup-mouse.el: Put copyright notice in canonical "Copyright DATE AUTHOR" form. Refer to XEmacs, not GNU Emacs, in permissions. * site-load.el: Add permission boilerplate. * mule/canna-leim.el: * alist.el: Refer to XEmacs, not APEL/this program, in permissions. * mule/canna-leim.el: Remove my copyright, I've assigned it to the FSF. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * gtk.el: * gtk-widget-accessors.el: * gtk-package.el: * gtk-marshal.el: * gtk-compose.el: * gnome.el: Add copyright notice based on internal evidence. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * easymenu.el: Add reference to COPYING to permission notice. * gutter.el: * gutter-items.el: * menubar-items.el: Fix typo "Xmacs" in permissions notice. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * auto-save.el: * font.el: * fontconfig.el: * mule/kinsoku.el: Add "part of XEmacs" text to permission notice. 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): * cl-macs.el (remf, getf): * cl-extra.el (tailp, cl-set-getf, cl-do-remf): * cl.el (ldiff, endp): Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; add circularity checking for the first two. #'cl-set-getf and #'cl-do-remf were Lisp implementations of #'plist-put and #'plist-remprop; change the names to aliases, changes the macros that use them to using #'plist-put and #'plist-remprop directly. 2010-10-12 Aidan Kehoe <kehoea@parhasard.net> * abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table): Create both these abbrev tables using the usual #'define-abbrev-table calls, rather than attempting to special-case them. * cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is being loaded interpreted. Previously other, later files would redundantly call (load "cl-macs") when interpreted, it's more reasonable to do it here, once. * cmdloop.el (read-quoted-char-radix): Use defcustom here, we don't have any dump-order dependencies that would prevent that. * custom.el (eval-when-compile): Don't load cl-macs when interpreted or when byte-compiling, rely on cl-extra.el in the former case and the appropriate entry in bytecomp-load-hook in the latter. Get rid of custom-declare-variable-list, we have no dump-time dependencies that would require it. * faces.el (eval-when-compile): Don't load cl-macs when interpreted or when byte-compiling. * packages.el: Remove some inaccurate comments. * post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not here, now the order of preloaded-file-list has been changed to make it available. * subr.el (custom-declare-variable-list): Remove. No need for it. Also remove a stub define-abbrev-table from this file, given the current order of preloaded-file-list there's no need for it. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are also constant. (byte-compile-initial-macro-environment): In #'the, if FORM is constant and does not match TYPE, warn at byte-compile time. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * backquote.el (bq-vector-contents, bq-list*): Remove; the former is equivalent to (append VECTOR nil), the latter to (list* ...). (bq-process-2): Use (append VECTOR nil) instead of using #'bq-vector-contents to convert to a list. (bq-process-1): Now we use list* instead of bq-list * subr.el (list*): Moved from cl.el, since it is now required to be available the first time a backquoted form is encountered. * cl.el (list*): Move to subr.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * test-harness.el (Check-Message): Add an omitted comma here, thank you the buildbot. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * hash-table.el (hash-table-key-list, hash-table-value-list) (hash-table-key-value-alist, hash-table-key-value-plist): Remove some useless #'nreverse calls in these files; our hash tables have no order, it's not helpful to pretend they do. * behavior.el (read-behavior): Do the same in this file, in some code evidently copied from hash-table.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * info.el (Info-insert-dir): * format.el (format-deannotate-region): * files.el (cd, save-buffers-kill-emacs): Use #'some, #'every and related functions for applying boolean operations to lists, instead of rolling our own ones that cons and don't short-circuit. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-initial-macro-environment): * cl-macs.el (the): Rephrase the docstring, make its implementation when compiling files a little nicer. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * descr-text.el (unidata-initialize-unicodedata-database) (unidata-initialize-unihan-database, describe-char-unicode-data) (describe-char-unicode-data): Wrap calls to the database functions with (with-fboundp ...), avoiding byte compile warnings on builds without support for the database functions. (describe-char): (reduce #'max ...), not (apply #'max ...), no need to cons needlessly. (describe-char): Remove a redundant lambda wrapping #'extent-properties. (describe-char-unicode-data): Call #'nsubst when replacing "" with nil in the result of #'split-string, instead of consing inside mapcar. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * x-faces.el (x-available-font-sizes): * specifier.el (let-specifier): * package-ui.el (pui-add-required-packages): * msw-faces.el (mswindows-available-font-sizes): * modeline.el (modeline-minor-mode-menu): * minibuf.el (minibuf-directory-files): Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): When these functions are handed more than two arguments, and those arguments have no side effects, transform to a series of two argument calls, avoiding funcall in the byte-compiled code. * mule/mule-cmds.el (finish-set-language-environment): Take advantage of this change in a function called 256 times at startup. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-function-form, byte-compile-quote) (byte-compile-quote-form): Warn at compile time, and error at runtime, if a (quote ...) or a (function ...) form attempts to quote more than one object. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc (mapcar ...)) to (mapcan ...); warn about use of the first idiom. * update-elc.el (do-autoload-commands): * packages.el (packages-find-package-library-path): * frame.el (frame-list): * extents.el (extent-descendants): * etags.el (buffer-tag-table-files): * dumped-lisp.el (preloaded-file-list): * device.el (device-list): * bytecomp-runtime.el (proclaim-inline, proclaim-notinline) Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files. * bytecomp-runtime.el (eval-when-compile, eval-and-compile): In passing, mention that these macros also evaluate the body when interpreted. tests/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test lexical scope for `block', `return-from'; add a Known-Bug-Expect-Failure for a contorted example that fails when byte-compiled.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 07 Feb 2011 12:01:24 +0000
parents aa20a889ff14
children b9167d522a9a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; backquote.el --- Full backquote support for elisp. Reverse compatible too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Keywords: extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;;; Synched up with: Not synched with FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; The bulk of the code is originally from CMU Common Lisp (original notice
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; below).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; It correctly supports nested backquotes and backquoted vectors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; Converted to work with elisp by Miles Bader <miles@cogsci.ed.ac.uk>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; Changes by Jonathan Stigelman <Stig@hackvan.com>:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; - Documentation added
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; - support for old-backquote-compatibility-hook nixed because the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; old-backquote compatibility is now done in the reader...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; - nixed support for |,.| because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; (a) it's not in CLtl2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; (b) ",.foo" is the same as ". ,foo"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; (c) because RMS isn't interested in using this version of backquote.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; ben@xemacs.org added ,. support back in:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; (a) yes, it is in CLtl2. Read closely on page 529.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; (b) RMS in 19.30 adds C support for ,. even if it's not really
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; handled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; **********************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; This code was written as part of the CMU Common Lisp project at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; Carnegie Mellon University, and has been placed in the public domain.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; If you want to use this code or any part of CMU Common Lisp, please contact
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; Scott Fahlman or slisp-group@cs.cmu.edu.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; **********************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; BACKQUOTE: Code Spice Lispified by Lee Schumacher.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; The flags passed back by BQ-PROCESS-2 can be interpreted as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; |`,|: [a] => a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; NIL: [a] => a ;the NIL flag is used only when a is NIL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; T: [a] => a ;the T flag is used when a is self-evaluating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; QUOTE: [a] => (QUOTE a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; APPEND: [a] => (APPEND . a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; NCONC: [a] => (NCONC . a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; LIST: [a] => (LIST . a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; LIST*: [a] => (LIST* . a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; The flags are combined according to the following set of rules:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; ([a] means that a should be converted according to the previous table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; \ car || otherwise | QUOTE or | |`,@| | |`,.|
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;;cdr \ || | T or NIL | |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;;============================================================================
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; |`,| ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a [d])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; NIL ||LIST ([a]) |QUOTE (a) |<hair> a |<hair> a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;;QUOTE or T||LIST* ([a] [d]) |QUOTE (a . d) |APPEND (a [d]) |NCONC (a [d])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; APPEND ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a . d) |NCONC (a [d])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; NCONC ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a . d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; LIST ||LIST ([a] . d) |LIST ([a] . d) |APPEND (a [d]) |NCONC (a [d])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;; LIST* ||LIST* ([a] . d) |LIST* ([a] . d) |APPEND (a [d]) |NCONC (a [d])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;;<hair> involves starting over again pretending you had read ".,a)" instead
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;; of ",@a)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; These are the forms it expects: |backquote| |`| |,| |,@| and |,.|.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (defconst bq-backquote-marker 'backquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (defconst bq-backtick-marker '\`) ; remnant of the old lossage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (defconst bq-comma-marker '\,)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (defconst bq-at-marker '\,@)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (defconst bq-dot-marker '\,\.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 ;;; ----------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (fset '\` 'backquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (defmacro backquote (template)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 "Expand the internal representation of a backquoted TEMPLATE into a lisp form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 The backquote character is like the quote character in that it prevents the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 template which follows it from being evaluated, except that backquote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 permits you to evaluate portions of the quoted template. A comma character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 inside TEMPLATE indicates that the following item should be evaluated. A
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 comma character may be followed by an at-sign, which indicates that the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 which follows should be evaluated and inserted and \"spliced\" into the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 template. Forms following ,@ must evaluate to lists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 Here is how to use backquotes:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (setq p 'b
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 q '(c d e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 `(a ,p ,@q) -> (a b c d e)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 `(a . b) -> (a . b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 `(a . ,p) -> (a . b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 The XEmacs lisp reader expands lisp backquotes as it reads them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Examples:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 `atom is read as (backquote atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 `(a ,b ,@(c d e)) is read as (backquote (a (\\, b) (\\,\\@ (c d e))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 `(a . ,p) is read as (backquote (a \\, p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 \(backquote TEMPLATE) is a macro that produces code to construct TEMPLATE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Note that this is very slow in interpreted code, but fast if you compile.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 TEMPLATE is one or more nested lists or vectors, which are `almost quoted'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 They are copied recursively, with elements preceded by comma evaluated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (backquote (a b)) == (list 'a 'b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (backquote (a [b c])) == (list 'a (vector 'b 'c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 However, certain special lists are not copied. They specify substitution.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 Lists that look like (\\, EXP) are evaluated and the result is substituted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (backquote (a (\\, (+ x 5)))) == (list 'a (+ x 5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Elements of the form (\\,\\@ EXP) are evaluated and then all the elements
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 of the result are substituted. This result must be a list; it may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 be `nil'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Elements of the form (\\,\\. EXP) are evaluated and then all the elements
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 of the result are concatenated to the list of preceding elements in the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 They must occur as the last element of a list (not a vector).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 EXP may evaluate to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 As an example, a simple macro `push' could be written:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (defmacro push (v l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 `(setq ,l (cons ,@(list v l))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 or as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (defmacro push (v l)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 `(setq ,l (cons ,v ,l)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 For backwards compatibility, old-style emacs-lisp backquotes are still read.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 OLD STYLE NEW STYLE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (` (foo (, bar) (,@ bing))) `(foo ,bar ,@bing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 Because of the old-style backquote support, you cannot use a new-style
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 backquoted form as the first element of a list. Perhaps some day this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 restriction will go away, but for now you should be wary of it:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (`(this ,will ,@fail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 ((` (but (, this) will (,@ work))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 This is an extremely rare thing to need to do in lisp."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (bq-process template))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 ;;; ----------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (defconst bq-comma-flag 'unquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (defconst bq-at-flag 'unquote-splicing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (defconst bq-dot-flag 'unquote-nconc-splicing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (defun bq-process (form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (let* ((flag-result (bq-process-2 form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (flag (car flag-result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (result (cdr flag-result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (cond ((eq flag bq-at-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (error ",@ after ` in form: %s" form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 ((eq flag bq-dot-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (error ",. after ` in form: %s" form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (bq-process-1 flag result)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 ;;; ----------------------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 ;;; This does the expansion from table 2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (defun bq-process-2 (code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (cond ((vectorp code)
5281
aa20a889ff14 Remove a couple of redundant functions, backquote.el
Aidan Kehoe <kehoea@parhasard.net>
parents: 428
diff changeset
190 (let* ((dflag-d (bq-process-2 (append code nil))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 ((atom code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (cond ((null code) (cons nil nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ((or (numberp code) (eq code t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (cons t code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (t (cons 'quote code))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 ((eq (car code) bq-at-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (cons bq-at-flag (nth 1 code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 ((eq (car code) bq-dot-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (cons bq-dot-flag (nth 1 code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 ((eq (car code) bq-comma-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (bq-comma (nth 1 code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 ((or (eq (car code) bq-backquote-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (eq (car code) bq-backtick-marker)) ; old lossage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (bq-process-2 (bq-process (nth 1 code))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (t (let* ((aflag-a (bq-process-2 (car code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (aflag (car aflag-a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (a (cdr aflag-a)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (let* ((dflag-d (bq-process-2 (cdr code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (dflag (car dflag-d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (d (cdr dflag-d)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (if (eq dflag bq-at-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 ;; get the errors later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (error ",@ after dot in %s" code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (if (eq dflag bq-dot-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (error ",. after dot in %s" code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 ((eq aflag bq-at-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (if (null dflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (bq-comma a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (cons 'append
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (cond ((eq dflag 'append)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (cons a d ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (t (list a (bq-process-1 dflag d)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 ((eq aflag bq-dot-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (if (null dflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (bq-comma a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (cons 'nconc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (cond ((eq dflag 'nconc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (cons a d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (t (list a (bq-process-1 dflag d)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 ((null dflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (if (memq aflag '(quote t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (cons 'quote (list a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (cons 'list (list (bq-process-1 aflag a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 ((memq dflag '(quote t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (if (memq aflag '(quote t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (cons 'quote (cons a d ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (cons 'list* (list (bq-process-1 aflag a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (bq-process-1 dflag d)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (t (setq a (bq-process-1 aflag a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (if (memq dflag '(list list*))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (cons dflag (cons a d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (cons 'list*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (list a (bq-process-1 dflag d)))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 ;;; This handles the <hair> cases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (defun bq-comma (code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (cond ((atom code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (cond ((null code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (cons nil nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ((or (numberp code) (eq code 't))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (cons t code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (t (cons bq-comma-flag code))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 ((eq (car code) 'quote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (cons (car code) (car (cdr code))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 ((memq (car code) '(append list list* nconc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (cons (car code) (cdr code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 ((eq (car code) 'cons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (cons 'list* (cdr code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (t (cons bq-comma-flag code))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 ;;; This handles table 1.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (defun bq-process-1 (flag thing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (cond ((or (eq flag bq-comma-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (memq flag '(t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 thing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 ((eq flag 'quote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (list 'quote thing))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ((eq flag 'vector)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (list 'apply '(function vector) thing))
5281
aa20a889ff14 Remove a couple of redundant functions, backquote.el
Aidan Kehoe <kehoea@parhasard.net>
parents: 428
diff changeset
272 (t (cons flag thing))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (provide 'backquote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 ;;; backquote.el ends here