(load "writeln.scm") ;;Implementation of a Tree data structure and ;;a breath-first traversal of the tree. ;Define a node object with local data and methods (define make-instance-node (lambda (myName) (define name myName) ;A string (define parent void) ;a node object (define childList ()) ;a list of nod objects (define node (lambda argList (define cmd (car argList)) (define args (cdr argList)) (cond ((eq? cmd 'getName) name) ((eq? cmd 'setParent) (set! parent (car args))) ((eq? cmd 'getParent) parent) ((eq? cmd 'addChild) (set! childList (append childList args))) ((eq? cmd 'getChildern) childList) (else die) ) )) node )) ;The whole tree is build one leaf at a time. ;This can not insert nodes mid tree. ;New space is alocated for the leaf. ;A pointer to this leaf is added to the parent's child list. (define addLeaf (lambda (nodeName parentNode) (define newNode (make-instance-node nodeName)) (newNode 'setParent parentNode) (parentNode 'addChild newNode) newNode )) ;Depth-first traversal of the tree. ;In this walk printTree is called on each child. ;Note, however, that the second child is not called ; until printTree of the first child returns. ; PrintTree of the first child does not return until ; all of the first child's descendant have been visited. (define printTree (lambda (subTree) (define myName (subTree 'getName)) (define childVector (list->vector (subTree 'getChildern))) (define n (vector-length childVector)) (define child void) ;Temporary value of current child in the list of children. (define childNames ()) ;List of child names to be printed. ;loop through the childern to get their names. (do ((i 0 (+ i 1))) ((>= i n)) (set! child (vector-ref childVector i)) (set! childNames (cons (child 'getName) childNames)) ) (writeln myName "--> " childNames) ;Loop again through the children and recurse on each child. (do ((i 0 (+ i 1))) ((>= i n)) (set! child (vector-ref childVector i)) (printTree child) ) )) (define root (addLeaf "Vertebrate" void)) (define nodeMammal (addLeaf "Mammal" root)) (define nodeBird (addLeaf "Bird" root)) (define nodeFinch (addLeaf "Finch" nodeBird)) (define nodeOwl (addLeaf "Owl" nodeBird)) (define nodeReptile (addLeaf "Reptile" root)) (define nodeLizard (addLeaf "Lizard" nodeReptile)) (define nodeSnake (addLeaf "Snake" nodeReptile)) (define nodeBoa(addLeaf "Boa" nodeSnake)) (define nodePython(addLeaf "Python" nodeSnake)) (define nodePitViper (addLeaf "Pit-Viper" nodeSnake)) (define nodeCopperhead(addLeaf "Copperhead" nodePitViper)) (define nodeRattlesnake(addLeaf "Rattlesnake" nodePitViper)) (define nodeGecko (addLeaf "Gecko" nodeLizard)) (define nodeChameleon (addLeaf "Chameleon" nodeLizard)) (define nodeSnowy (addLeaf "Snowy" nodeOwl)) (define nodeFlammulated (addLeaf "Flammulated" nodeOwl)) (printTree root)