TimeKeeper/audio/flite-2.0.0-release/tools/make_vallist.scm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                     ;;;
;;;                  Language Technologies Institute                    ;;;
;;;                     Carnegie Mellon University                      ;;;
;;;                         Copyright (c) 2001                          ;;;
;;;                        All Rights Reserved.                         ;;;
;;;                                                                     ;;;
;;; Permission is hereby granted, free of charge, to use and distribute ;;;
;;; this software and its documentation without restriction, including  ;;;
;;; without limitation the rights to use, copy, modify, merge, publish, ;;;
;;; distribute, sublicense, and/or sell copies of this work, and to     ;;;
;;; permit persons to whom this work is furnished to do so, subject to  ;;;
;;; the following conditions:                                           ;;;
;;;  1. The code must retain the above copyright notice, this list of   ;;;
;;;     conditions and the following disclaimer.                        ;;;
;;;  2. Any modifications must be clearly marked as such.               ;;;
;;;  3. Original authors' names are not deleted.                        ;;;
;;;  4. The authors' names are not used to endorse or promote products  ;;;
;;;     derived from this software without specific prior written       ;;;
;;;     permission.                                                     ;;;
;;;                                                                     ;;;
;;; CARNEGIE MELLON UNIVERSITY AND THE CONTRIBUTORS TO THIS WORK        ;;;
;;; DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING     ;;;
;;; ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT  ;;;
;;; SHALL CARNEGIE MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE     ;;;
;;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   ;;;
;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN  ;;;
;;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,         ;;;
;;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF      ;;;
;;; THIS SOFTWARE.                                                      ;;;
;;;                                                                     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;             Author: Alan W Black (awb@cs.cmu.edu)                   ;;;
;;;               Date: January 2001                                    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                     ;;;
;;; Convert a lisp list/tree into a static cst_val const                ;;;
;;;                                                                     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar cells_count 0)
(defvar cells_cache nil)

(define (listtocstval name l ofile)
  "(listtocstval name l ofile)
Converts a lisp list to static C code into ofile."
  (let ((ofdc (fopen ofile "w")))
    (format ofdc "/*******************************************************/\n")
    (format ofdc "/**  Autogenerated list structure for %s    */\n" name)
    (format ofdc "/*******************************************************/\n")
    (format ofdc "\n")
    (format ofdc "#include \"cst_string.h\"\n")
    (format ofdc "#include \"cst_val.h\"\n")

    (set! cells_count 0)
    (set! cells_cache nil)

    (format ofdc "\n\n")

    (cellstovals name l ofdc)
    (format ofdc "cst_val *%s = &%s_%04d;\n" name name cells_count)

    (format ofdc "\n\n")

    (fclose ofdc)
    ))

(define (cellsnewname name)
  (set! cells_count (+ 1 cells_count))
  (format nil "%s_%04d" name cells_count))

(define (cellstovals name l ofdc)
  (let (nn)
    (cond
     ((null l) "0")
     ((set! nn (assoc l cells_cache))
      (car (cdr nn)))
     ((consp l)
      (let ((c_ar (cellstovals name (car l) ofdc))
	    (c_dr (cellstovals name (cdr l) ofdc))
	    (n_name (cellsnewname name)))
	(if (not (string-equal "0" c_ar))
	    (set! c_ar (string-append "(void *)&" c_ar)))
	(if (not (string-equal "0" c_dr))
	    (set! c_dr (string-append "(void *)&" c_dr)))
	(format ofdc "DEF_STATIC_CONST_VAL_CONS(%s,%s,%s);\n"
		n_name 
		c_ar 
		c_dr)
	(set! cells_cache (cons (list l n_name)))
	n_name))
     ((symbol? l)
      (let ((n_name (cellsnewname name)))
	(format ofdc "DEF_STATIC_CONST_VAL_STRING(%s,\"%s\");\n"
		n_name l)
	(set! cells_cache (cons (list l n_name)))
	n_name))
     ((equal? 'string (typeof l))
      (let ((n_name (cellsnewname name)))
	(format ofdc "DEF_STATIC_CONST_VAL_STRING(%s,%l);\n"
		n_name l)
	(set! cells_cache (cons (list l n_name)))
	n_name))
     ((number? l)
      (let ((n_name (cellsnewname name)))
	(format ofdc "DEF_STATIC_CONST_VAL_FLOAT(%s,%s);\n"
		n_name l)
	(set! cells_cache (cons (list l n_name)))
	n_name))
     (t
      (format stderr "cannot convert to vals\n")
      (error l)))))

(provide 'make_vallist)