Return to backquote.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

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

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