5 The Multitasking Facility

5.4 A coded example

The fringe of a tree that is made up of conses is defined as an ordered list of the atoms at the leaves of the tree. The following sample code defines a function calledsamefringe, which uses multitasking to determine whether two trees have the same fringe. The function creates processes that walk through two trees and compare them atom for atom.

;;; This function is the top level of a process that enumerates 
;;; the fringe atoms of a tree made up of conses.  It uses the 
;;; value of RESULT-SYMBOL to communicate with other processes.  
;;; Whenever it encounters an atom, it stores it in RESULT-SYMBOL.  
;;; When the atom has been compared with a fringe atom of the 
;;; second tree, RESULT-SYMBOL is set to NIL, and the process 
;;; moves to the next node.  When the atoms of both trees have 
;;; been compared, RESULT-SYMBOL is set to the special value :END. 
;;;
;;; Note: this code won't work if the tree contains NIL or :END 
;;;       as atoms.

(defun fringe-top-level (tree result-symbol)
  (fringe-top-level-1 tree result-symbol)
  (set result-symbol :end))

(defun fringe-top-level-1 (tree result-symbol)
  (cond ((atom tree)                   ; An atom is found.
         (set result-symbol tree)      ; Report the found atom.
         (process-wait "Symbol Ready"   
                                 ; Wait until symbol becomes nil
           #'(lambda () (null (symbol-value result-symbol))))
         )
        (t                           ; If it is a cons, continue.
         (fringe-top-level (car tree) result-symbol)
         (fringe-top-level (cdr tree) result-symbol))))

(defun samefringe (tree1 tree2)
  "Determine whether TREE1 and TREE2 have the same atoms in the
 same order"
  ;; sym1 and sym2 are used to communicate between processes.
  (let ((sym1 (gensym))		
        (sym2 (gensym)))
    (set sym1 nil)
    (set sym2 nil)
    (let ((proc1 (make-process :name "Tree 1"
                               :stack-size 3000
                               :function 'fringe-top-level
                               :args (list tree1 sym1)))
          (proc2 (make-process :name "Tree 2"
                               :stack-size 3000
                               :function 'fringe-top-level
                               :args (list tree2 sym2))))
      (unwind-protect	        ; Make sure processes get killed.
         ;; Wait until both processes have found fringing symbols.  
        ;; If they do not match, exit immediately.
          (loop
            (unless
              (eq (process-wait "Tree 1" #'(lambda () 
                                        (symbol-value sym1)))
                  (process-wait "Tree 2" #'(lambda () 
                                        (symbol-value sym2))))
              (return nil))
         ;; If atoms still match at the end of the search, signal  
         ;; that the end has been reached and that the fringes
         ;; match.
            (when (eq (symbol-value sym1) :end) 
              (return t))		
         ;; Flush the communication cells to allow the processes
         ;; to run again.
            (set sym1 nil)		
            (set sym2 nil))		
        ;; If the comparison is not over, kill the processes.
        (unless (eq (symbol-value sym1) :end) 
          (kill-process proc1))		
        (unless (eq (symbol-value sym2) :end) 
          (kill-process proc2))))))

The appendix "A Multitasking Application" presents a more detailed example of multitasking, as well as a sample session.

The Advanced User's Guide - 9 SEP 1996

Generated with Harlequin WebMaker