home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / lib / module_description.scm < prev    next >
Lisp/Scheme  |  1999-05-30  |  5KB  |  118 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;                                                                       ;;
  3. ;;;                Centre for Speech Technology Research                  ;;
  4. ;;;                     University of Edinburgh, UK                       ;;
  5. ;;;                       Copyright (c) 1996,1997                         ;;
  6. ;;;                        All Rights Reserved.                           ;;
  7. ;;;                                                                       ;;
  8. ;;;  Permission is hereby granted, free of charge, to use and distribute  ;;
  9. ;;;  this software and its documentation without restriction, including   ;;
  10. ;;;  without limitation the rights to use, copy, modify, merge, publish,  ;;
  11. ;;;  distribute, sublicense, and/or sell copies of this work, and to      ;;
  12. ;;;  permit persons to whom this work is furnished to do so, subject to   ;;
  13. ;;;  the following conditions:                                            ;;
  14. ;;;   1. The code must retain the above copyright notice, this list of    ;;
  15. ;;;      conditions and the following disclaimer.                         ;;
  16. ;;;   2. Any modifications must be clearly marked as such.                ;;
  17. ;;;   3. Original authors' names are not deleted.                         ;;
  18. ;;;   4. The authors' names are not used to endorse or promote products   ;;
  19. ;;;      derived from this software without specific prior written        ;;
  20. ;;;      permission.                                                      ;;
  21. ;;;                                                                       ;;
  22. ;;;  THE UNIVERSITY OF EDINBURGH AND THE CONTRIBUTORS TO THIS WORK        ;;
  23. ;;;  DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING      ;;
  24. ;;;  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT   ;;
  25. ;;;  SHALL THE UNIVERSITY OF EDINBURGH NOR THE CONTRIBUTORS BE LIABLE     ;;
  26. ;;;  FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES    ;;
  27. ;;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN   ;;
  28. ;;;  AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,          ;;
  29. ;;;  ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF       ;;
  30. ;;;  THIS SOFTWARE.                                                       ;;
  31. ;;;                                                                       ;;
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ;;;  
  34. ;;;  Handle module descriptions.
  35. ;;;  
  36.  
  37. (defvar *module-descriptions* nil
  38.   "*module-descriptions*
  39.    An association list recording the description objects for proclaimed
  40.    modules.")
  41.  
  42. (define (set_module_description mod desc)
  43.   "(set_module_description MOD DESC)
  44.    Set the description for the module named MOD."
  45.   (let ((entry (assoc mod *module-descriptions*)))
  46.     (if entry
  47.     (set-cdr! entry (cons desc nil))
  48.     (set! *module-descriptions* (cons (cons mod (cons desc nil)) 
  49.                       *module-descriptions*))
  50.     )
  51.     )
  52.   )
  53.  
  54. (define (module_description mod)
  55.   "(module_description MOD)
  56.    Returns the description record of the module named by symbol MOD"
  57.   (let ((entry (assoc mod *module-descriptions*)))
  58.     (if entry
  59.     (car (cdr entry))
  60.     nil
  61.     )
  62.     )
  63.   )
  64.  
  65. (defmac (proclaim form)
  66.   "(proclaim NAME &opt DESCRIPTION...)
  67.    Anounce the availability of a module NAME. DESCRIPTION
  68.    is a description in a fixed format."
  69.   (let ((name (car (cdr form)))
  70.     (description (cdr form))
  71.     )
  72.     (list 'proclaim-real (list 'quote name) (list 'quote description))
  73.     )
  74.   )
  75.  
  76. (define (proclaim-real name description)
  77.   (set! *modules* (cons name *modules*))
  78. ;  (if description
  79. ;      (set_module_description name (create_module_description description))
  80. ;      )
  81.   )
  82.  
  83. (define (describe_module mod)
  84.   "(describe_module MOD)
  85.    Describe the module named by the symbol MOD."
  86.  
  87.   (let ((entry (module_description mod)))
  88.     (format t "---------------------\n")
  89.     (if entry
  90.     (print_module_description entry)
  91.     (format t "No description for %l\n" mod)
  92.     )
  93.     (format t "---------------------\n")
  94.     )
  95.   )
  96.  
  97. (define (describe_all_modules)
  98.   "(describe_all_modules)
  99.    Print descriptions of all proclaimed modules"
  100.   (format t "---------------------\n")
  101.   (let ((p *module-descriptions*))
  102.     (while p
  103.        (print_module_description (car (cdr (car p))))
  104.        (format t "---------------------\n")
  105.        (set! p (cdr p))
  106.        )
  107.     )
  108.   )
  109.  
  110. (proclaim 
  111.  module_description 1.1 
  112.  "CSTR"  "Richard Caley <rjc@cstr.ed.ac.uk>"
  113.   ( "Handle module descriptions from C++ and from Scheme."
  114.    )
  115.   )
  116.  
  117. (provide 'module_description)
  118.