Paste number 81766: Tree building macro

Paste number 81766: Tree building macro
Pasted by: malcolm reynolds
When:7 months, 4 weeks ago
Share:Tweet this! | http://paste.lisp.org/+1R3A
Channel:None
Paste contents:
Raw Source | XML | Display As
;;; Old version (this worked fine)
(defmacro make-tree (tree-struct)
  (with-gensyms (tree parent recurse-spec)
    `(let ((,tree (make-instance 'tree))
           (,parent (make-instance 'tree-node :nid ,(car tree-struct))))
       (add-root ,tree ,parent)
       (let ((,recurse-spec ',(caddr tree-struct)))
         (dbg :make-tree "Would recurse on ~A~%" ,recurse-spec)
         (make-tree-list ,tree ,parent ,(caddr tree-struct)))
       (dbg :make-tree "Children of root after finishing: ~A~%" (children ,parent)\
)
       (finalise-tree ,tree)
       ,tree)))

(defmacro make-tree-rec (tree parent child-id &key ch rpar)
  (with-gensyms (new-child)
    `(let ((,new-child (make-instance 'tree-node :nid ,child-id)))
       (dbg :make-tree "Children of root right now: ~A~%" (children (root ,tree)))
       ,(if rpar `(add-connection ,tree ,parent ,new-child ,rpar))
       ,(if ch `(make-tree-list ,tree ,new-child ,ch)))))

(defmacro make-tree-list (tree parent tstructs)
  `(progn
     ,@(mapcar #'(lambda (cspec)
                  `(make-tree-rec ,tree ,parent ,@cspec))
              tstructs)))

;;; New version, where I want to use :gid for the data
;;;I was previously passing as :nid, and I want to generate
;;;the :nid's sequentially for each tree as we go down.

(defvar *nid-counter* nil)

(defmacro make-tree (tree-struct)
  (with-gensyms (tree parent recurse-spec nid-counter)
    `(let* ((,nid-counter 0)
	    (*nid-counter* #'(lambda () (incf ,nid-counter))))
       (let* ((,tree (make-instance 'tree))
	      (,parent (make-instance 'tree-node
				      :nid (funcall *nid-counter*)
				      :gid ,(car tree-struct))))
	 (princ "done init")
	 (format t "Two calls: ~A ~A" (funcall *nid-counter*) (funcall *nid-counter*))
	 (add-root ,tree ,parent)
	 (let ((,recurse-spec ',(caddr tree-struct)))
	   (dbg :make-tree "Would recurse on ~A~%" ,recurse-spec)
	   (make-tree-list ,tree ,parent ,(caddr tree-struct)))
	 (dbg :make-tree "Children of root after finishing: ~A~%" (children ,parent))
	 (finalise-tree ,tree)
	 ,tree))))

(defmacro make-tree-rec (tree parent child-id &key ch rpar)
  (with-gensyms (new-child)
    `(let ((,new-child (make-instance 'tree-node
				      :nid (funcall *nid-counter*)
				      :gid ,child-id)))
       (dbg :make-tree "Children of root right now: ~A~%" (children (root ,tree)))
       ,(if rpar `(add-connection ,tree ,parent ,new-child ,rpar))
       ,(if ch `(make-tree-list ,tree ,new-child ,ch)))))

(defmacro make-tree-list (tree parent tstructs)
  `(progn
     ,@(mapcar #'(lambda (cspec)
		  `(make-tree-rec ,tree ,parent ,@cspec))
	      tstructs)))

;;; Example structure that I might expand make-tree with:
(defun make-test-tree-a ()
  (make-tree (0 :ch ((1 :rpar 2
			:ch ((4 :rpar 1)))
		     (2 :rpar 3
			:ch ((5 :rpar 1)
			     (6 :rpar 1)))
		     (3 :rpar 2)))))


This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.