;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                                                                     ;;;;;;                  Language Technologies Institute                    ;;;;;;                     Carnegie Mellon University                      ;;;;;;                         Copyright (c) 1999                          ;;;;;;                        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: December 1999                                   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                                                                     ;;;;;; Generate a C compilable lts rules.                                  ;;;;;;                                                                     ;;;;;; Two modes, from decision graphs as wfsts or from CART trees         ;;;;;;                                                                     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; These are preordained by the LTS building process(set! lts_context_window_size 4)(set! lts_context_extra_feats 1) (define (ltsregextoC name trees idir odir)  "(ltsregextoC name idir odir)Converts its wfsts to a C compilation structure for flite.  Assumes$idir/[a-z].tree.wfst to compile from."  (let     ((ofde (fopen (path-append odir (string-append name "_lts_rules.c")) "w"))     (ofdm (fopen (path-append odir (string-append name "_lts_model.c")) "w"))     (ofdh (fopen (path-append odir (string-append name "_lts_model.h")) "w"))     (ifd)     (rule_index nil))    (set! lts_pos 0)    (set! phone_table (list "epsilon"))    (set! letter_table (list "nothing" "#" "0"))    (set! letter_table (append letter_table (mapcar car trees)))     (format ofde "/*******************************************************/\n")    (format ofde "/**  Autogenerated lts rules (regex) for %s     */\n" name)    (format ofde "/**  from %s    */\n" idir)    (format ofde "/*******************************************************/\n")    (format ofde "\n")    (format ofde "#include \"cst_string.h\"\n")    (format ofde "#include \"cst_lts.h\"\n")    (format ofde "#include \"cst_lexicon.h\"\n")     (format ofdm "/*******************************************************/\n")    (format ofdm "/**  Autogenerated lts rules (regex) for %s     */\n" name)    (format ofdm "/**  from %s    */\n" idir)    (format ofdm "/*******************************************************/\n")    (format ofdm "\n")    (format ofdm "#include \"cst_string.h\"\n")    (format ofdm "#include \"cst_lts.h\"\n")    (format ofdm "#include \"cst_lexicon.h\"\n")    (format ofdm "#include \"%s_lts_model.h\"\n\n" name)    (format ofdm "const cst_lts_model %s_lts_model[] = \n" name)    (format ofdm "{\n")     (set! ln 0)    (mapcar     (lambda (l)       (let ((ifd (fopen (path-append idir 			  (string-append l ".tree.wfst")) "r")))	 (format t "doing: %s\n" l)	 (format ofdm "   /** letter \"%s\" **/\n" l)	 (format ofdh "   /** letter \"%s\" **/\n" l)	 (set! rule_index (cons (list l lts_pos ln) rule_index))	 (set! lts_pos (dump_lts_wfst ln ifd ofdm ofdh lts_pos))	 (fclose ifd)         (set! ln (+ 1 ln))         ))     (cdr (cddr letter_table))     )    (format ofdm "    0, 0, 0,0, 0,0\n")    (format ofdm "};\n")     ;; Make the letter table be the same order as the rule inde (+2)     ;; The phone table (bytes to phone names)    (format ofde "\n")    (format ofde "const char * const %s_lts_phone_table[%d] = \n" 	    name (+ 1 (length phone_table)))    (format ofde "{\n")    (mapcar (lambda (p) (format ofde "    \"%s\",\n" p)) phone_table)    (format ofde "    NULL\n")    (format ofde "};\n")     ;; The letter_table (bytes to letter names)    (format ofde "\n")    (format ofde "const char * const %s_lts_letter_table[%d] = \n" 	    name (+ 1 (length letter_table)))    (format ofde "{\n")    (mapcar (lambda (p) (format ofde "    \"%s\",\n" p)) letter_table)    (format ofde "    NULL\n")    (format ofde "};\n")     ;; Which rule starts where    (format ofde "\n")    (format ofde "const cst_lts_addr %s_lts_letter_index[%d] = \n" 	    name (+ 1 (length rule_index)) )    (format ofde "{\n")    (mapcar      (lambda (p) (format ofde "    %d, /* %s */\n" (car (cdr p)) (car p)))     (reverse rule_index))    (format ofde "    0\n")    (format ofde "};\n")     (format ofde "\n") ;     (format ofde "const cst_lts_rules %s_lts_rules = {\n" name);     (format ofde "   \"%s\",\n" name);     (format ofde "   %s_lts_letter_index,\n" name);     (format ofde "   %s_lts_model,\n" name);     (format ofde "   %s_lts_phone_table,\n" name);     (format ofde "   4, /* context_window_size */\n");     (format ofde "   1,  /* context_extra_feats */\n");     (format ofde "   %s_lts_letter_table\n" name);     (format ofde "};\n");     (format ofde "\n")     (fclose ofde)    (fclose ofdh)    (fclose ofdm)    )) (define (dump_lts_wfst ln ifd ofde ofdh lts_pos)  "(dump_lts_wfst ifd ofde ofdh lts_pos)Dump the WFST as a byte table to ifd.  Jumps are dumped as#define's to ofdh so forward references work.  lts_pos is the rule position.  Each state is saves as    feature  value  true_addr  false_addrFeature and value are single bytes, which addrs are double bytes."  (let ((state))    ;; Skip WFST header    (while (not (string-equal (set! state (readfp ifd)) "EST_Header_End"))       (if (equal? state (eof-val))	   (error "eof in lts regex file")))    (while (not (equal? (set! state (readfp ifd)) (eof-val)))      (format ofdh "#define LTS_STATE_%d_%d %s\n" 	      ln (car (car state)) 	      (lts_bytify lts_pos))      (cond        ((string-equal "final" (car (cdr (car state))))	(set! lts_pos (- lts_pos 1))	t) ;; do nothing       ((string-matches (car (car (cdr state))) ".*_.*")	(format ofde "   %s, %d, %s , %s , \n"		(lts_feat (car (car (cdr state))));		(lts_val (car (car (cdr state))))		(lts_let_num (lts_letter (car (car (cdr state)))) 0 letter_table)		(format nil "LTS_STATE_%d_%d" ln			(car (cdr (cdr (car (cdr (cdr state)))))))		(format nil "LTS_STATE_%d_%d" ln 			(car (cdr (cdr (car (cdr state))))))))       (t ;; its a letter output state	(format ofde "   255, %s, 0,0 , 0,0 , \n"		(lts_phone (car (car (cdr state))) 0 phone_table))))      (set! lts_pos (+ 1 lts_pos)))    lts_pos)) (define (lts_feat trans)  "(lts_feat trans)Returns the feature number represented in this transition name."  (let ((fname (substring trans 5 (- (length trans) 11))))    (if (string-matches fname ".*_i?")	(set! fname (string-before fname "_")))    (cond     ((string-equal fname "p.p.p.p.name") 0)     ((string-equal fname "p.p.p.name") 1)     ((string-equal fname "p.p.name") 2)     ((string-equal fname "p.name") 3)     ((string-equal fname "n.name") 4)     ((string-equal fname "n.n.name") 5)     ((string-equal fname "n.n.n.name") 6)     ((string-equal fname "n.n.n.n.name") 7)     (t (error (format nil "ltsregex2C: unknown feat %s %s\n" fname trans )))))) (define (lts_letter trans)  "(lts_val trans)The letter being tested."  (string-before (string-after trans "is_") "_")) (define (lts_val trans)  "(lts_val trans)The letter being tested."  (substring trans (- (length trans) 2) 1)) (define (lts_phone p n table)  (cond   ((string-equal p (car table))    n)   ((not (cdr table))  ;; new p    (set-cdr! table (list p))    (+ 1 n))   (t    (lts_phone p (+ 1 n) (cdr table))))) (define (lts_let_num p n table)  (cond   ((null table)    (format t "no entry %s %d\n" p n)    (errrr))   ((string-equal p (car table))    n)   (t    (lts_let_num p (+ 1 n) (cdr table)))))  (define (lts_bytify n)  "(lts_bytify n)Return this short as a two byte comma separated string."  (let ((xx (format nil "%04x" n)))    ;; This is unfortunately byte order specific    (format nil "0x%s,0x%s"	    (substring xx 2 2)	    (substring xx 0 2)))) (provide 'make_lts)