File:  [CSRG BSD Unix] / 3BSD / cmd / lisp / lib / backquote
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 16:12:53 2018 UTC (8 years, 1 month ago) by root
Branches: MAIN, CSRG
CVS tags: HEAD, BSD3
BSD 3.0

(setsyntax '";" 'splicing 'zapline)
(setq **backquote** 1)

(setsyntax '"`" 'macro '(lambda nil
  (back=quotify  ((lambda (**backquote**) (read)) 
		    (add1 **backquote**)))))

(setsyntax '"," 'macro '(lambda nil
  ((lambda (**backquote**)
	   (cond ((zerop **backquote**)
		  (break '"comma not inside a backquote."))
		 ((equal (tyipeek) 64)
		  (tyi)
		  (cons '",@" (read)))
		 (t (cons '"," (read)))))
   (sub1 **backquote**]

(def back=quotify 
  (lambda (x)
	  ((lambda (a d aa ad dqp)
		   (cond ((atom x) (list 'quote x))
			 ((eq (car x) '",") (cdr x))
			 ((or (atom (car x))
			      (not (memq (caar x) '( ",@" ",."))))
			  (setq a (back=quotify (car x)) d (back=quotify (cdr x))
				ad (atom d) aa (atom a)
				dqp (and (not ad) (eq (car d) 'quote)))
			  (cond ((and dqp (not (atom a)) (eq (car a) 'quote))
				 (list 'quote (cons (cadr a) (cadr d))))
				((and dqp (null (cadr d)))
				 (list 'list a))
				((and (not ad) (eq (car d) 'list))
				 (cons 'list (cons a (cdr d))))
				(t (list 'cons a d))))
			 ((eq (caar x) '",@")
			  (list 'append (cdar x) (back=quotify (cdr x))))
			 ((eq (caar x) '",.")
			  (list 'nconc (cdar x)(back=quotify (cdr x))))
			 ))
	   nil nil nil nil nil)))

unix.superglobalmegacorp.com

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