Return to backquote CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / lisp / lib

Annotation of 3BSD/cmd/lisp/lib/backquote, revision 1.1.1.1

1.1       root        1: (setsyntax '";" 'splicing 'zapline)
                      2: (setq **backquote** 1)
                      3: 
                      4: (setsyntax '"`" 'macro '(lambda nil
                      5:   (back=quotify  ((lambda (**backquote**) (read)) 
                      6:                    (add1 **backquote**)))))
                      7: 
                      8: (setsyntax '"," 'macro '(lambda nil
                      9:   ((lambda (**backquote**)
                     10:           (cond ((zerop **backquote**)
                     11:                  (break '"comma not inside a backquote."))
                     12:                 ((equal (tyipeek) 64)
                     13:                  (tyi)
                     14:                  (cons '",@" (read)))
                     15:                 (t (cons '"," (read)))))
                     16:    (sub1 **backquote**]
                     17: 
                     18: (def back=quotify 
                     19:   (lambda (x)
                     20:          ((lambda (a d aa ad dqp)
                     21:                   (cond ((atom x) (list 'quote x))
                     22:                         ((eq (car x) '",") (cdr x))
                     23:                         ((or (atom (car x))
                     24:                              (not (memq (caar x) '( ",@" ",."))))
                     25:                          (setq a (back=quotify (car x)) d (back=quotify (cdr x))
                     26:                                ad (atom d) aa (atom a)
                     27:                                dqp (and (not ad) (eq (car d) 'quote)))
                     28:                          (cond ((and dqp (not (atom a)) (eq (car a) 'quote))
                     29:                                 (list 'quote (cons (cadr a) (cadr d))))
                     30:                                ((and dqp (null (cadr d)))
                     31:                                 (list 'list a))
                     32:                                ((and (not ad) (eq (car d) 'list))
                     33:                                 (cons 'list (cons a (cdr d))))
                     34:                                (t (list 'cons a d))))
                     35:                         ((eq (caar x) '",@")
                     36:                          (list 'append (cdar x) (back=quotify (cdr x))))
                     37:                         ((eq (caar x) '",.")
                     38:                          (list 'nconc (cdar x)(back=quotify (cdr x))))
                     39:                         ))
                     40:           nil nil nil nil nil)))

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