rhubarb-lip-sync/rhubarb/lib/flite-1.4/tools/make_vallist.scm

115 lines
5.0 KiB
Scheme

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; 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)