1 ;;; These are preordained by the LTS building process
2 (set! lts_context_window_size 4)
3 (set! lts_context_extra_feats 1)
5 (define (dump_ltsregex idir)
6 (let ((ifd) (rule_index nil))
8 (set! phone_table (list "epsilon"))
9 (set! letter_table (list "nothing" "#" "0"
10 "a" "b" "c" "d" "e" "f" "g"
11 "h" "i" "j" "k" "l" "m" "n"
12 "o" "p" "q" "r" "s" "t" "u"
17 (let ((ifd (fopen (path-append
19 (string-append l ".tree.wfst")) "r")))
20 (format t "doing: %s\n" l)))
21 (cdr (cddr letter_table))
24 (define (dump_lts_wfst l ifd ofde ofdh lts_pos)
25 "(dump_lts_wfst ifd ofde ofdh lts_pos)
26 Dump the WFST as a byte table to ifd. Jumps are dumped as
27 #define's to ofdh so forward references work. lts_pos is the
28 rule position. Each state is saves as
29 feature value true_addr false_addr
30 Feature and value are single bytes, which addrs are double bytes."
33 (while (not (string-equal (set! state (readfp ifd)) "EST_Header_End"))
34 (if (equal? state (eof-val))
35 (error "eof in lts regex file")))
36 (while (not (equal? (set! state (readfp ifd)) (eof-val)))
37 (format ofdh "#define LTS_STATE_%s_%d %s\n"
41 ((string-equal "final" (car (cdr (car state))))
42 (set! lts_pos (- lts_pos 1))
44 ((string-matches (car (car (cdr state))) ".*_.*")
45 (format ofde " %s, %s, %s , %s , \n"
46 (lts_feat (car (car (cdr state))))
47 ; (lts_val (car (car (cdr state))))
48 (lts_phone (lts_letter (car (car (cdr state)))) 0 letter_table)
49 (format nil "LTS_STATE_%s_%d" l
50 (car (cdr (cdr (car (cdr (cdr state)))))))
51 (format nil "LTS_STATE_%s_%d" l
52 (car (cdr (cdr (car (cdr state))))))))
53 (t ;; its a letter output state
54 (format ofde " 255, %s, 0,0 , 0,0 , \n"
55 (lts_phone (car (car (cdr state))) 0 phone_table))))
56 (set! lts_pos (+ 1 lts_pos)))
59 (define (lts_feat trans)
61 Returns the feature number represented in this transition name."
62 (let ((fname (substring trans 5 (- (length trans) 11))))
63 (if (string-matches fname ".*_i?")
64 (set! fname (string-before fname "_")))
66 ((string-equal fname "p.p.p.p.name") 0)
67 ((string-equal fname "p.p.p.name") 1)
68 ((string-equal fname "p.p.name") 2)
69 ((string-equal fname "p.name") 3)
70 ((string-equal fname "n.name") 4)
71 ((string-equal fname "n.n.name") 5)
72 ((string-equal fname "n.n.n.name") 6)
73 ((string-equal fname "n.n.n.n.name") 7)
74 (t (error (format nil "ltsregex2C: unknown feat %s %s\n" fname trans ))))))
76 (define (lts_letter trans)
78 The letter being tested."
79 (string-before (string-after trans "is_") "_"))
81 (define (lts_phone p n table)
83 ((string-equal p (car table))
85 ((not (cdr table)) ;; new p
86 (set-cdr! table (list p))
89 (lts_phone p (+ 1 n) (cdr table)))))
91 (define (lts_bytify n)
93 Return this short as a two byte comma separated string."
94 (let ((xx (format nil "%04x" n)))
95 ;; This is unfortunately byte order specific
96 (format nil "0x%s,0x%s"