Return to backquote.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/backquote.el, revision 1.1

1.1     ! root        1: ;; Copyright (C) 1985 Free Software Foundation, Inc.
        !             2: ;; Written by Dick King (king@kestrel).
        !             3: 
        !             4: ;; This file is part of GNU Emacs.
        !             5: 
        !             6: ;; GNU Emacs is distributed in the hope that it will be useful,
        !             7: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: ;; accepts responsibility to anyone for the consequences of using it
        !             9: ;; or for whether it serves any particular purpose or works at all,
        !            10: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: ;; License for full details.
        !            12: 
        !            13: ;; Everyone is granted permission to copy, modify and redistribute
        !            14: ;; GNU Emacs, but only under the conditions described in the
        !            15: ;; GNU Emacs General Public License.   A copy of this license is
        !            16: ;; supposed to have been given to you along with GNU Emacs so you
        !            17: ;; can know your rights and responsibilities.  It should be in a
        !            18: ;; file named COPYING.  Among other things, the copyright notice
        !            19: ;; and this notice must be preserved on all copies.
        !            20: 
        !            21: 
        !            22: ;;; This is a rudimentry backquote package written by D. King,
        !            23:  ;;; king@kestrel, on 8/31/85.  (` x) is a macro
        !            24:  ;;; that expands to a form that produces x.  (` (a b ..)) is
        !            25:  ;;; a macro that expands into a form that produces a list of what a b
        !            26:  ;;; etc. would have produced.  Any element can be of the form
        !            27:  ;;; (, <form>) in which case the resulting form evaluates
        !            28:  ;;; <form> before putting it into place, or (,@ <form>), in which
        !            29:  ;;; case the evaluation of <form> is arranged for and each element
        !            30:  ;;; of the result (which must be a (possibly null) list) is inserted.
        !            31: ;;; As an example, the immediately following macro push (v l) could
        !            32:  ;;; have been written 
        !            33: ;;;    (defmacro push (v l)
        !            34: ;;;         (` (setq (, l) (cons (,@ (list v l))))))
        !            35:  ;;; although
        !            36: ;;;    (defmacro push (v l)
        !            37: ;;;         (` (setq (, l) (cons (, v) (, l)))))
        !            38:  ;;; is far more natural.  The magic atoms ,
        !            39:  ;;; and ,@ are user-settable and list-valued.  We recommend that
        !            40:  ;;; things never be removed from this list lest you break something
        !            41:  ;;; someone else wrote in the dim past that comes to be recompiled in
        !            42:  ;;; the distant future.
        !            43: 
        !            44: ;;; LIMITATIONS: tail consing is not handled correctly.  Do not say
        !            45:  ;;; (` (a . (, b))) - say (` (a (,@ b)))
        !            46:  ;;; which works even if b is not list-valued.
        !            47: ;;; No attempt is made to handle vectors.  (` [a (, b) c]) doesn't work.
        !            48: ;;; Sorry, you must say things like
        !            49:  ;;; (` (a (,@ 'b))) to get (a . b) and 
        !            50:  ;;; (` ((, ',) c)) to get (, c) - [(` (a , b)) will work but is a bad habit]
        !            51: ;;; I haven't taught it the joys of nconc.
        !            52: ;;; (` atom) dies.  (` (, atom)) or anything else is okay.
        !            53: 
        !            54: ;;; BEWARE BEWARE BEWARE
        !            55:  ;;; inclusion of (,atom) rather than (, atom) or (,@atom) rather than
        !            56:  ;;; (,@ atom) will result in errors that will show up very late.
        !            57:  ;;; This is so crunchy that I am considering including a check for
        !            58:  ;;; this or changing the syntax to ... ,(<form>).  RMS: opinion?
        !            59: 
        !            60: 
        !            61: (provide 'backquote)
        !            62: 
        !            63: ;;; a raft of general-purpose macros follows.  See the nearest
        !            64:  ;;; Commonlisp manual.
        !            65: (defmacro bq-push (v l)
        !            66:   "Pushes evaluated first form onto second unevaluated object
        !            67: a list-value atom"
        !            68:   (list 'setq l (list 'cons v l)))
        !            69: 
        !            70: (defmacro bq-caar (l)
        !            71:   (list 'car (list 'car l)))
        !            72: 
        !            73: (defmacro bq-cadr (l)
        !            74:   (list 'car (list 'cdr l)))
        !            75: 
        !            76: (defmacro bq-cdar (l)
        !            77:   (list 'cdr (list 'car l)))
        !            78: 
        !            79: 
        !            80: ;;; These two advertised variables control what characters are used to
        !            81:  ;;; unquote things.  I have included , and ,@ as the unquote and
        !            82:  ;;; splice operators, respectively, to give users of MIT CADR machine
        !            83:  ;;; derivitive machines a warm, cosy feeling.
        !            84: 
        !            85: (defconst backquote-unquote '(,)
        !            86:   "*A list of all objects that stimulate unquoting in `.  Memq test.")
        !            87: 
        !            88: 
        !            89: (defconst backquote-splice '(,@)
        !            90:   "*A list of all objects that stimulate splicing in `.  Memq test.")
        !            91: 
        !            92: 
        !            93: ;;; This is the interface 
        !            94: (defmacro ` (form)
        !            95:   "(` FORM) Expands to a form that will generate FORM.
        !            96: FORM is `almost quoted' -- see backquote.el for a description."
        !            97:   (bq-make-maker form))
        !            98: 
        !            99: ;;; We develop the method for building the desired list from
        !           100:  ;;; the end towards the beginning.  The contract is that there be a
        !           101:  ;;; variable called state and a list called tailmaker, and that the form
        !           102:  ;;; (cons state tailmaker) deliver the goods.  Exception - if the
        !           103:  ;;; state is quote the tailmaker is the form itself.
        !           104: ;;; This function takes a form and returns what I will call a maker in
        !           105:  ;;; what follows.  Evaluating the maker would produce the form,
        !           106:  ;;; properly evaluated according to , and ,@ rules.
        !           107: ;;; I work backwards - it seemed a lot easier.  The reason for this is
        !           108:  ;;; if I'm in some sort of a routine building a maker and I switch
        !           109:  ;;; gears, it seemed to me easier to jump into some other state and
        !           110:  ;;; glue what I've already done to the end, than to to prepare that
        !           111:  ;;; something and go back to put things together.
        !           112: (defun bq-make-maker (form)
        !           113:   "Given one argument, a `mostly quoted' object, produces a maker.
        !           114: See backquote.el for details"
        !           115:   (let ((tailmaker (quote nil)) (qc 0) (ec 0) (state nil))
        !           116:     (mapcar 'bq-iterative-list-builder (reverse form))
        !           117:     (and state
        !           118:         (cond ((eq state 'quote)
        !           119:                (list state tailmaker))
        !           120:               ((= (length tailmaker) 1)
        !           121:                (funcall (bq-cadr (assq state bq-singles)) tailmaker))
        !           122:               (t (cons state tailmaker))))))
        !           123: 
        !           124: ;;; There are exceptions - we wouldn't want to call append of one
        !           125:  ;;; argument, for example.
        !           126: (defconst bq-singles '((quote bq-quotecar)
        !           127:                       (append car)
        !           128:                       (list bq-make-list)
        !           129:                       (cons bq-id)))
        !           130: 
        !           131: (defun bq-id (x) x)
        !           132: 
        !           133: (defun bq-quotecar (x) (list 'quote (car x)))
        !           134: 
        !           135: (defun bq-make-list (x) (cons 'list x))
        !           136: 
        !           137: ;;; fr debugging use only
        !           138: ;(defun funcalll (a b) (funcall a b))
        !           139: ;(defun funcalll (a b) (debug nil 'enter state tailmaker a b)
        !           140: ;  (let ((ans (funcall a b))) (debug  nil 'leave state tailmaker)
        !           141: ;       ans))
        !           142: 
        !           143: ;;; Given a state/tailmaker pair that already knows how to make a
        !           144:  ;;; partial tail of the desired form, this function knows how to add
        !           145:  ;;; yet another element to the burgening list.  There are four cases;
        !           146:  ;;; the next item is an atom (which will certainly be quoted); a 
        !           147:  ;;; (, xxx), which will be evaluated and put into the list at the top
        !           148:  ;;; level; a (,@ xxx), which will be evaluated and spliced in, or
        !           149:  ;;; some other list, in which case we first compute the form's maker,
        !           150:  ;;; and then we either launch into the quoted case if the maker's
        !           151:  ;;; top level function is quote, or into the comma case if it isn't.
        !           152: ;;; The fourth case reduces to one of the other three, so here we have
        !           153:  ;;; a choice of three ways to build tailmaker, and cit turns out we
        !           154:  ;;; use five possible values of state (although someday I'll add
        !           155:  ;;; nconcto the possible values of state).
        !           156: ;;; This maintains the invariant that (cons state tailmaker) is the
        !           157:  ;;; maker for the elements of the tail we've eaten so far.
        !           158: (defun bq-iterative-list-builder (form)
        !           159:   "Called by bq-make-maker.  Adds a new item form to tailmaker, 
        !           160: changing state if need be, so tailmaker and state constitute a recipie
        !           161: for making the list so far."
        !           162:   (cond ((atom form)
        !           163:         (funcall (bq-cadr (assq state bq-quotefns)) form))
        !           164:        ((memq (car form) backquote-unquote)
        !           165:         (funcall (bq-cadr (assq state bq-evalfns)) (bq-cadr form)))
        !           166:        ((memq (car form) backquote-splice)
        !           167:         (funcall (bq-cadr (assq state bq-splicefns)) (bq-cadr form)))
        !           168:        (t
        !           169:         (let ((newform (bq-make-maker form)))
        !           170:           (if (and (listp newform) (eq (car newform) 'quote))
        !           171:               (funcall (bq-cadr (assq state bq-quotefns)) (bq-cadr newform))
        !           172:             (funcall (bq-cadr (assq state bq-evalfns)) newform))))
        !           173:        ))
        !           174: 
        !           175: ;;; We do a 2-d branch on the form of splicing and the old state.
        !           176:  ;;; Here's fifteen functions' names...
        !           177: (defconst bq-splicefns '((nil bq-splicenil)
        !           178:                         (append bq-spliceappend)
        !           179:                         (list bq-splicelist)
        !           180:                         (quote bq-splicequote)
        !           181:                         (cons bq-splicecons)))
        !           182: 
        !           183: (defconst bq-evalfns '((nil bq-evalnil)
        !           184:                       (append bq-evalappend)
        !           185:                       (list bq-evallist)
        !           186:                       (quote bq-evalquote)
        !           187:                       (cons bq-evalcons)))
        !           188: 
        !           189: (defconst bq-quotefns '((nil bq-quotenil)
        !           190:                        (append bq-quoteappend)
        !           191:                        (list bq-quotelist)
        !           192:                        (quote bq-quotequote)
        !           193:                        (cons bq-quotecons)))
        !           194: 
        !           195: ;;; The name of each function is
        !           196:  ;;; (concat 'bq- <type-of-element-addition> <old-state>)
        !           197: ;;; I'll comment the non-obvious ones before the definitions...
        !           198:  ;;; In what follows, uppercase letters and form will always be
        !           199:  ;;; metavariables that don't need commas in backquotes, and I will
        !           200:  ;;; assume the existence of something like matches that takes a
        !           201:  ;;; backquote-like form and a value, binds metavariables and returns
        !           202:  ;;; t if the pattern match is successful, returns nil otherwise.  I
        !           203:  ;;; will write such a goodie someday.
        !           204: 
        !           205: ;;;   (setq tailmaker
        !           206:  ;;;      (if (matches ((quote X) Y) tailmaker)
        !           207:  ;;;          (` ((quote (form X)) Y))
        !           208:  ;;;        (` ((list form (quote X)) Y))))
        !           209:  ;;;  (setq state 'append)
        !           210: (defun bq-quotecons (form)
        !           211:   (if (and (listp (car tailmaker))
        !           212:           (eq (bq-caar tailmaker) 'quote))
        !           213:       (setq tailmaker
        !           214:            (list (list 'quote (list form (bq-cadr (car tailmaker))))
        !           215:                  (bq-cadr tailmaker))) 
        !           216:     (setq tailmaker
        !           217:          (list (list 'list
        !           218:                      (list 'quote form)
        !           219:                      (car tailmaker))
        !           220:                (bq-cadr tailmaker))))
        !           221:   (setq state 'append))
        !           222: 
        !           223: (defun bq-quotequote (form)
        !           224:   (bq-push form tailmaker))
        !           225: 
        !           226: ;;; Could be improved to convert (list 'a 'b 'c .. 'w x) 
        !           227:  ;;;                          to (append '(a b c .. w) x)
        !           228:  ;;; when there are enough elements
        !           229: (defun bq-quotelist (form)
        !           230:   (bq-push (list 'quote form) tailmaker))
        !           231: 
        !           232: ;;; (setq tailmaker
        !           233:  ;;;  (if (matches ((quote X) (,@ Y)))
        !           234:  ;;;      (` ((quote (, (cons form X))) (,@ Y)))))
        !           235: (defun bq-quoteappend (form)
        !           236:   (cond ((and (listp tailmaker)
        !           237:           (listp (car tailmaker))
        !           238:           (eq (bq-caar tailmaker) 'quote))
        !           239:         (rplaca (bq-cdar tailmaker)
        !           240:                 (cons form (car (bq-cdar tailmaker)))))
        !           241:        (t (bq-push (list 'quote (list form)) tailmaker))))
        !           242: 
        !           243: (defun bq-quotenil (form)
        !           244:   (setq tailmaker (list form))
        !           245:   (setq state 'quote))
        !           246: 
        !           247: ;;; (if (matches (X Y) tailmaker)  ; it must
        !           248:  ;;;    (` ((list form X) Y)))
        !           249: (defun bq-evalcons (form)
        !           250:   (setq tailmaker
        !           251:        (list (list 'list form (car tailmaker))
        !           252:              (bq-cadr tailmaker)))
        !           253:   (setq state 'append))
        !           254: 
        !           255: ;;;  (if (matches (X Y Z (,@ W)))
        !           256:  ;;;     (progn (setq state 'append)
        !           257:  ;;;            (` ((list form) (quote (X Y Z (,@ W))))))
        !           258:  ;;;     (progn (setq state 'list)
        !           259:  ;;;            (list form 'X 'Y .. )))  ;  quote each one there is
        !           260: (defun bq-evalquote (form)
        !           261:   (cond ((< (length tailmaker) 3)
        !           262:         (setq tailmaker
        !           263:               (cons form
        !           264:                     (mapcar (function (lambda (x)
        !           265:                                         (list 'quote x)))
        !           266:                             tailmaker)))
        !           267:         (setq state 'list))
        !           268:        (t
        !           269:         (setq tailmaker
        !           270:               (list (list 'list form)
        !           271:                     (list 'quote tailmaker)))
        !           272:         (setq state 'append))))
        !           273: 
        !           274: (defun bq-evallist (form)
        !           275:   (bq-push form tailmaker))
        !           276: 
        !           277: ;;;  (cond ((matches ((list (,@ X)) (,@ Y)))
        !           278:  ;;;        (` ((list form  (,@ X)) (,@ Y))))
        !           279:  ;;;       ((matches (X))
        !           280:  ;;;        (` (form (,@ X))) (setq state 'cons))
        !           281:  ;;;       ((matches ((,@ X)))
        !           282:  ;;;        (` (form (,@ X)))))
        !           283: (defun bq-evalappend (form)
        !           284:   (cond ((and (listp tailmaker)
        !           285:           (listp (car tailmaker))
        !           286:           (eq (bq-caar tailmaker) 'list))
        !           287:         (rplacd (car tailmaker)
        !           288:                 (cons form (bq-cdar tailmaker))))
        !           289:        ((= (length tailmaker) 1)
        !           290:         (setq tailmaker (cons form tailmaker))
        !           291:         (setq state 'cons))
        !           292:        (t (bq-push (list 'list form) tailmaker))))
        !           293: 
        !           294: (defun bq-evalnil (form)
        !           295:   (setq tailmaker (list form))
        !           296:   (setq state 'list))
        !           297: 
        !           298: ;;; (if (matches (X Y))  ; it must
        !           299:  ;;;    (progn (setq state 'append)
        !           300:  ;;;           (` (form (cons X Y)))))   ; couldn't think of anything clever
        !           301: (defun bq-splicecons (form)
        !           302:   (setq tailmaker
        !           303:        (list form
        !           304:              (list 'cons (car tailmaker) (bq-cadr tailmaker))))
        !           305:   (setq state 'append))
        !           306: 
        !           307: (defun bq-splicequote (form)
        !           308:   (setq tailmaker (list form (list 'quote (list tailmaker))))
        !           309:   (setq state 'append))
        !           310: 
        !           311: (defun bq-splicelist (form)
        !           312:   (setq tailmaker (list form (cons 'list tailmaker)))
        !           313:   (setq state 'append))
        !           314: 
        !           315: (defun bq-spliceappend (form)
        !           316:   (bq-push form tailmaker))
        !           317: 
        !           318: (defun bq-splicenil (form)
        !           319:   (setq state 'append)
        !           320:   (setq tailmaker (list form)))
        !           321: 
        !           322: 
        !           323: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.