tree.lisp 1.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647
  1. ;;; -*- Mode: Lisp; show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: TREE; -*-
  2. ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
  3. (in-package #:tree)
  4. (defun make-node (data)
  5. "Creates a new node with DATA as contents"
  6. (cons (cons data nil) nil))
  7. (defun add-child (node child)
  8. "Takes two nodes created with MAKE-NODE and adds CHILD"
  9. (nconc (first node) child)
  10. node)
  11. (defun first-child (node)
  12. "Returns a reference to the first child of NODE"
  13. (rest (first node)))
  14. (defun next-sibling (node)
  15. "Returns next SIBLING of NODE"
  16. (rest node))
  17. (defun data (node)
  18. "Returns the information in NODE"
  19. (first (first node)))
  20. (defun traverse (tree func &optional (depth 0))
  21. "Depth-first traversal of TREE calling FUNC for each node"
  22. (when tree
  23. (funcall func (data tree) depth)
  24. (traverse (first-child tree) func (+ 2 depth))
  25. (traverse (next-sibling tree) func depth)))
  26. (defun print-tree (tree)
  27. "Print the nodes of TREE"
  28. (traverse tree (lambda (node depth) (format t "~v@tNode: ~a~%" depth node))))
  29. (defun find-tree (tree test)
  30. "Find all nodes in TREE where TEST returns T"
  31. (let ((results))
  32. (traverse tree (lambda (node depth)
  33. (declare (ignore depth))
  34. (when (funcall test node)
  35. (push node results))))
  36. (nreverse results)))
  37. (let ((pkg (find-package :tree)))
  38. (do-all-symbols (sym pkg) (when (eql (symbol-package sym) pkg) (export sym pkg))))