Return to backquote.el CVS log

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

Annotation of 43BSD/contrib/emacs/lisp/backquote.el, revision 1.1

1.1     ! root        1: ;; Copyright (C) 1985 Free Software Foundation
        !             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 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 caar (l)
        !            71:   (list 'car (list 'car l)))
        !            72: 
        !            73: (defmacro cadr (l)
        !            74:   (list 'car (list 'cdr l)))
        !            75: 
        !            76: (defmacro cdar (l)
        !            77:   (list 'cdr (list 'car l)))
        !            78: 
        !            79: (defmacro cddr (l)
        !            80:   (list 'cdr (list 'cdr l)))
        !            81: 
        !            82: 
        !            83: ;;; These two advertised variables control what characters are used to
        !            84:  ;;; unquote things.  I have included , and ,@ as the unquote and
        !            85:  ;;; splice operators, respectively, to give users of MIT CADR machine
        !            86:  ;;; derivitive machines a warm, cosy feeling.
        !            87: 
        !            88: (defconst backquote-unquote '(,)
        !            89:   "*A list of all objects that stimulate unquoting in `.  Memq test.")
        !            90: 
        !            91: 
        !            92: (defconst backquote-splice '(,@)
        !            93:   "*A list of all objects that stimulate splicing in `.  Memq test.")
        !            94: 
        !            95: 
        !            96: ;;; This is the interface 
        !            97: (defmacro ` (form)
        !            98:   "(` FORM) Expands to a form that will generate FORM.
        !            99: FORM is `almost quoted' -- see backquote.el for a description."
        !           100:   (bq-make-maker form))
        !           101: 
        !           102: ;;; We develop the method for building the desired list from
        !           103:  ;;; the end towards the beginning.  The contract is that there be a
        !           104:  ;;; variable called state and a list called tailmaker, and that the form
        !           105:  ;;; (cons state tailmaker) deliver the goods.  Exception - if the
        !           106:  ;;; state is quote the tailmaker is the form itself.
        !           107: ;;; This function takes a form and returns what I will call a maker in
        !           108:  ;;; what follows.  Evaluating the maker would produce the form,
        !           109:  ;;; properly evaluated according to , and ,@ rules.
        !           110: ;;; I work backwards - it seemed a lot easier.  The reason for this is
        !           111:  ;;; if I'm in some sort of a routine building a maker and I switch
        !           112:  ;;; gears, it seemed to me easier to jump into some other state and
        !           113:  ;;; glue what I've already done to the end, than to to prepare that
        !           114:  ;;; something and go back to put things together.
        !           115: (defun bq-make-maker (form)
        !           116:   "Given one argument, a `mostly quoted' object, produces a maker.
        !           117: See backquote.el for details"
        !           118:   (let ((tailmaker (quote nil)) (qc 0) (ec 0) (state nil))
        !           119:     (mapcar 'bq-iterative-list-builder (reverse form))
        !           120:     (and state
        !           121:         (cond ((eq state 'quote)
        !           122:                (list state tailmaker))
        !           123:               ((= (length tailmaker) 1)
        !           124:                (funcall (cadr (assq state bq-singles)) tailmaker))
        !           125:               (t (cons state tailmaker))))))
        !           126: 
        !           127: ;;; There are exceptions - we wouldn't want to call append of one
        !           128:  ;;; argument, for example.
        !           129: (defconst bq-singles '((quote bq-quotecar)
        !           130:                       (append car)
        !           131:                       (list bq-make-list)
        !           132:                       (cons bq-id)))
        !           133: 
        !           134: (defun bq-id (x) x)
        !           135: 
        !           136: (defun bq-quotecar (x) (list 'quote (car x)))
        !           137: 
        !           138: (defun bq-make-list (x) (cons 'list x))
        !           139: 
        !           140: ;;; fr debugging use only
        !           141: ;(defun funcalll (a b) (funcall a b))
        !           142: ;(defun funcalll (a b) (debug nil 'enter state tailmaker a b)
        !           143: ;  (let ((ans (funcall a b))) (debug  nil 'leave state tailmaker)
        !           144: ;       ans))
        !           145: 
        !           146: ;;; Given a state/tailmaker pair that already knows how to make a
        !           147:  ;;; partial tail of the desired form, this function knows how to add
        !           148:  ;;; yet another element to the burgening list.  There are four cases;
        !           149:  ;;; the next item is an atom (which will certainly be quoted); a 
        !           150:  ;;; (, xxx), which will be evaluated and put into the list at the top
        !           151:  ;;; level; a (,@ xxx), which will be evaluated and spliced in, or
        !           152:  ;;; some other list, in which case we first compute the form's maker,
        !           153:  ;;; and then we either launch into the quoted case if the maker's
        !           154:  ;;; top level function is quote, or into the comma case if it isn't.
        !           155: ;;; The fourth case reduces to one of the other three, so here we have
        !           156:  ;;; a choice of three ways to build tailmaker, and cit turns out we
        !           157:  ;;; use five possible values of state (although someday I'll add
        !           158:  ;;; nconcto the possible values of state).
        !           159: ;;; This maintains the invariant that (cons state tailmaker) is the
        !           160:  ;;; maker for the elements of the tail we've eaten so far.
        !           161: (defun bq-iterative-list-builder (form)
        !           162:   "Called by bq-make-maker.  Adds a new item form to tailmaker, 
        !           163: changing state if need be, so tailmaker and state constitute a recipie
        !           164: for making the list so far."
        !           165:   (cond ((atom form)
        !           166:         (funcall (cadr (assq state bq-quotefns)) form))
        !           167:        ((memq (car form) backquote-unquote)
        !           168:         (funcall (cadr (assq state bq-evalfns)) (cadr form)))
        !           169:        ((memq (car form) backquote-splice)
        !           170:         (funcall (cadr (assq state bq-splicefns)) (cadr form)))
        !           171:        (t
        !           172:         (let ((newform (bq-make-maker form)))
        !           173:           (if (and (listp newform) (eq (car newform) 'quote))
        !           174:               (funcall (cadr (assq state bq-quotefns)) (cadr newform))
        !           175:             (funcall (cadr (assq state bq-evalfns)) newform))))
        !           176:        ))
        !           177: 
        !           178: ;;; We do a 2-d branch on the form of splicing and the old state.
        !           179:  ;;; Here's fifteen functions' names...
        !           180: (defconst bq-splicefns '((nil bq-splicenil)
        !           181:                         (append bq-spliceappend)
        !           182:                         (list bq-splicelist)
        !           183:                         (quote bq-splicequote)
        !           184:                         (cons bq-splicecons)))
        !           185: 
        !           186: (defconst bq-evalfns '((nil bq-evalnil)
        !           187:                       (append bq-evalappend)
        !           188:                       (list bq-evallist)
        !           189:                       (quote bq-evalquote)
        !           190:                       (cons bq-evalcons)))
        !           191: 
        !           192: (defconst bq-quotefns '((nil bq-quotenil)
        !           193:                        (append bq-quoteappend)
        !           194:                        (list bq-quotelist)
        !           195:                        (quote bq-quotequote)
        !           196:                        (cons bq-quotecons)))
        !           197: 
        !           198: ;;; The name of each function is
        !           199:  ;;; (concat 'bq- <type-of-element-addition> <old-state>)
        !           200: ;;; I'll comment the non-obvious ones before the definitions...
        !           201:  ;;; In what follows, uppercase letters and form will always be
        !           202:  ;;; metavariables that don't need commas in backquotes, and I will
        !           203:  ;;; assume the existence of something like matches that takes a
        !           204:  ;;; backquote-like form and a value, binds metavariables and returns
        !           205:  ;;; t if the pattern match is successful, returns nil otherwise.  I
        !           206:  ;;; will write such a goodie someday.
        !           207: 
        !           208: ;;;   (setq tailmaker
        !           209:  ;;;      (if (matches ((quote X) Y) tailmaker)
        !           210:  ;;;          (` ((quote (form X)) Y))
        !           211:  ;;;        (` ((list form (quote X)) Y))))
        !           212:  ;;;  (setq state 'append)
        !           213: (defun bq-quotecons (form)
        !           214:   (if (and (listp (car tailmaker))
        !           215:           (eq (caar tailmaker) 'quote))
        !           216:       (setq tailmaker
        !           217:            (list (list 'quote (list form (cadr (car tailmaker))))
        !           218:                  (cadr tailmaker))) 
        !           219:     (setq tailmaker
        !           220:          (list (list 'list
        !           221:                      (list 'quote form)
        !           222:                      (car tailmaker))
        !           223:                (cadr tailmaker))))
        !           224:   (setq state 'append))
        !           225: 
        !           226: (defun bq-quotequote (form)
        !           227:   (push form tailmaker))
        !           228: 
        !           229: ;;; Could be improved to convert (list 'a 'b 'c .. 'w x) 
        !           230:  ;;;                          to (append '(a b c .. w) x)
        !           231:  ;;; when there are enough elements
        !           232: (defun bq-quotelist (form)
        !           233:   (push (list 'quote form) tailmaker))
        !           234: 
        !           235: ;;; (setq tailmaker
        !           236:  ;;;  (if (matches ((quote X) (,@ Y)))
        !           237:  ;;;      (` ((quote (, (cons form X))) (,@ Y)))))
        !           238: (defun bq-quoteappend (form)
        !           239:   (cond ((and (listp tailmaker)
        !           240:           (listp (car tailmaker))
        !           241:           (eq (caar tailmaker) 'quote))
        !           242:         (rplaca (cdar tailmaker)
        !           243:                 (cons form (car (cdar tailmaker)))))
        !           244:        (t (push (list 'quote (list form)) tailmaker))))
        !           245: 
        !           246: (defun bq-quotenil (form)
        !           247:   (setq tailmaker (list form))
        !           248:   (setq state 'quote))
        !           249: 
        !           250: ;;; (if (matches (X Y) tailmaker)  ; it must
        !           251:  ;;;    (` ((list form X) Y)))
        !           252: (defun bq-evalcons (form)
        !           253:   (setq tailmaker
        !           254:        (list (list 'list form (car tailmaker))
        !           255:              (cadr tailmaker)))
        !           256:   (setq state 'append))
        !           257: 
        !           258: ;;;  (if (matches (X Y Z (,@ W)))
        !           259:  ;;;     (progn (setq state 'append)
        !           260:  ;;;            (` ((list form) (quote (X Y Z (,@ W))))))
        !           261:  ;;;     (progn (setq state 'list)
        !           262:  ;;;            (list form 'X 'Y .. )))  ;  quote each one there is
        !           263: (defun bq-evalquote (form)
        !           264:   (cond ((< (length tailmaker) 3)
        !           265:         (setq tailmaker
        !           266:               (cons form
        !           267:                     (mapcar (function (lambda (x)
        !           268:                                         (list 'quote x)))
        !           269:                             tailmaker)))
        !           270:         (setq state 'list))
        !           271:        (t
        !           272:         (setq tailmaker
        !           273:               (list (list 'list form)
        !           274:                     (list 'quote tailmaker)))
        !           275:         (setq state 'append))))
        !           276: 
        !           277: (defun bq-evallist (form)
        !           278:   (push form tailmaker))
        !           279: 
        !           280: ;;;  (cond ((matches ((list (,@ X)) (,@ Y)))
        !           281:  ;;;        (` ((list form  (,@ X)) (,@ Y))))
        !           282:  ;;;       ((matches (X))
        !           283:  ;;;        (` (form (,@ X))) (setq state 'cons))
        !           284:  ;;;       ((matches ((,@ X)))
        !           285:  ;;;        (` (form (,@ X)))))
        !           286: (defun bq-evalappend (form)
        !           287:   (cond ((and (listp tailmaker)
        !           288:           (listp (car tailmaker))
        !           289:           (eq (caar tailmaker) 'list))
        !           290:         (rplacd (car tailmaker)
        !           291:                 (cons form (cdar tailmaker))))
        !           292:        ((= (length tailmaker) 1)
        !           293:         (setq tailmaker (cons form tailmaker))
        !           294:         (setq state 'cons))
        !           295:        (t (push (list 'list form) tailmaker))))
        !           296: 
        !           297: (defun bq-evalnil (form)
        !           298:   (setq tailmaker (list form))
        !           299:   (setq state 'list))
        !           300: 
        !           301: ;;; (if (matches (X Y))  ; it must
        !           302:  ;;;    (progn (setq state 'append)
        !           303:  ;;;           (` (form (cons X Y)))))   ; couldn't think of anything clever
        !           304: (defun bq-splicecons (form)
        !           305:   (setq tailmaker
        !           306:        (list form
        !           307:              (list 'cons (car tailmaker) (cadr tailmaker))))
        !           308:   (setq state 'append))
        !           309: 
        !           310: (defun bq-splicequote (form)
        !           311:   (setq tailmaker (list form (list 'quote (list tailmaker))))
        !           312:   (setq state 'append))
        !           313: 
        !           314: (defun bq-splicelist (form)
        !           315:   (setq tailmaker (list form (cons 'list tailmaker)))
        !           316:   (setq state 'append))
        !           317: 
        !           318: (defun bq-spliceappend (form)
        !           319:   (push form tailmaker))
        !           320: 
        !           321: (defun bq-splicenil (form)
        !           322:   (setq state 'append)
        !           323:   (setq tailmaker (list form)))
        !           324: 
        !           325: 
        !           326: 

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