home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / fest-141.zip / festival / examples / make_utts.sh < prev    next >
Lisp/Scheme  |  1999-09-09  |  20KB  |  559 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-*-mode:scheme-*-
  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. ;;;           Author:  Alan W Black
  34. ;;;           Date:    November 1997
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;;
  37. ;;;  Build a utterance from a number of stream label files including
  38. ;;;  building the links between the stream items
  39. ;;;
  40. ;;;  This used to be a shell script but that was just soooo slow
  41. ;;;  and inflexible it was better to do it in Festival
  42. ;;;
  43.  
  44. ;;; Because this is a --script type file it has to explicitly
  45. ;;; load the initfiles: init.scm and user's .festivalrc
  46. (if (not (symbol-bound? 'caar))
  47.     (load (path-append libdir "init.scm")))
  48.  
  49. ;;;  Some parts are potentially editable
  50. (defvar basic_relations '((Phrase segmental ())
  51.               (Word segmental (Phrase))
  52.               (Syllable segmental (Word) )
  53.               (Segment segmental (Syllable))
  54.               (IntEvent point (Syllable) )
  55.               (Target point (Segment))  ;; virtually unused
  56.               )
  57.   "The basic relations that exist and need to be combined into a single
  58. utterance.  Also their type, that is if they describe segments of
  59. the utterance or points in the utterance.")
  60.  
  61. (require 'tilt)
  62.  
  63. (define (make_utts_help)
  64.   (format t "%s\n"
  65.   "make_utts [options] festival/relations/Segment/*.Segment
  66.   Build utterance forms for sets of stream_item labels
  67.   Options
  68.   -utt_dir <string>
  69.              Directory where utterances will be saved (default
  70.              is festival/utts/)
  71.   -label_dir <string>
  72.              The directory which contains subdirectories containing
  73.              label files for each relation, default is festival/relations/
  74.   -style <string>
  75.              What style of utternaces, classic or unisyn
  76.   -tilt_events 
  77.              IntEvent files are tilt event so uses special information
  78.              in the syllink feature to link to syllables.
  79.   -eval <file>
  80.              Load in scheme file with run specific code, if file name
  81.              starts with a left parent the string itsefl is interpreted
  82.   -tokens
  83.              Overly non-general method to load in Tokens and markup
  84.   -pos
  85.              Do part of speech assignment
  86.   -phoneset <string>
  87.              Specify the phoneset name, this is required for -tilt_events.
  88. ")
  89.   (quit))
  90.  
  91. ;;; Default options values
  92. (defvar seg_files nil)  ;; files to build from
  93. (defvar label_dir "festival/relations/")
  94. (defvar style 'classic)
  95. (defvar tilt_events nil)
  96. (defvar with_tokens nil)
  97. (defvar unisyn_build_with_silences t)
  98. (defvar do_pos nil)
  99. (defvar do_syn nil)
  100. (defvar utt_dir "festival/utts/")
  101.  
  102. ;; may be redefined by user
  103. (define (make_utts_user_function utt) utt)
  104.  
  105. ;;; Get options
  106. (define (get_options)
  107.   (let ((files nil)
  108.     (o argv))
  109.     (if (or (member_string "-h" argv)
  110.         (member_string "-help" argv)
  111.         (member_string "--help" argv)
  112.         (member_string "-?" argv))
  113.     (make_utts_help))
  114.     (while o
  115.       (begin
  116.     (cond
  117.      ((string-equal "-label_dir" (car o))
  118.       (if (not (cdr o))
  119.           (make_utts_error "no label_dir file specified"))
  120.       (set! label_dir (car (cdr o)))
  121.       (set! o (cdr o)))
  122.      ((string-equal "-utt_dir" (car o))
  123.       (if (not (cdr o))
  124.           (make_utts_error "no utt_dir file specified"))
  125.       (set! utt_dir (car (cdr o)))
  126.       (set! o (cdr o)))
  127.      ((string-equal "-phoneset" (car o))
  128.       (if (not (cdr o))
  129.           (make_utts_error "no phoneset specified"))
  130.       (load_library (string-append (car (cdr o)) "_phones.scm"))
  131.       (set! o (cdr o)))
  132.      ((string-equal "-eval" (car o))
  133.       (if (not (cdr o))
  134.           (make_utts_error "no file specified to load"))
  135.       (if (string-matches (car (cdr o)) "^(.*")
  136.           (eval (read-from-string (car (cdr o))))
  137.           (load (car (cdr o))))
  138.       (set! o (cdr o)))
  139.      ((string-equal "-tilt_events" (car o))
  140.       (set! tilt_events t))
  141.      ((string-equal "-style" (car o))
  142.       (if (not (cdr o))
  143.           (make_utts_error "no style specified"))
  144.       (set! style (car (cdr o)))
  145.       (set! o (cdr o)))
  146.      ((string-equal "-tokens" (car o))
  147.       (set! with_tokens t))
  148.      ((string-equal "-pos" (car o))
  149.       (set! do_pos t))
  150.      (t
  151.       (set! files (cons (car o) files))))
  152.     (set! o (cdr o))))
  153.     (if files
  154.     (set! seg_files (reverse files)))))
  155.  
  156. (define (make_utts_error message)
  157.   (format stderr "%s: %s\n" "make_utts" message)
  158.   (make_utts_help))
  159.  
  160. ;;; No gc messages
  161. (gc-status nil)
  162.  
  163. (define (make_utt name relations)
  164.   "(make_utt dir name relations)
  165. Build an utterance from the stream_item label files in 
  166. dir/RELATION/name.RELATION and return it.  This also creates 
  167. relations between each base relation."
  168.   (let (utt)
  169.     (cond
  170.      ((equal? 'classic style)
  171.       (set! utt (make_utt_classic name relations)))
  172.      ((equal? 'unisyn style)
  173.       (set! utt (make_utt_unisyn name relations)))
  174.      (t
  175.       (err "make_utts: unknown style" style)))
  176.  
  177.     (utt.set_feat utt "fileid" name)
  178.     (if do_pos
  179.     (find_pos utt))
  180.     (if do_syn
  181.     (find_syn utt))
  182.  
  183.     utt)
  184. )
  185.  
  186. ;; These should probably be somewhere else
  187. (defvar met_insertion 7)
  188. (defvar met_deletion 7)
  189. (defvar met_substitution 7)
  190.  
  191. (define (make_utt_unisyn name relation)
  192.   "(make_utt_classic name relations)
  193. Build utterance, with xml, metrical tree and tilt relations."
  194.   (let ((utt (Utterance nil nil)))
  195.  
  196.     (set! utt (wsi_build utt name label_dir tilt_events))
  197.  
  198.     (add_xml_relation 
  199.      utt (string-append label_dir "xml/rhet/" name ".xrhet"))
  200.     (add_xml_relation 
  201.      utt (string-append label_dir "xml/syn/" name ".xsyn"))
  202.     (add_xml_relation 
  203.      utt (string-append label_dir "xml/anaph/" name ".xana"))
  204.     (add_xml_relation 
  205.      utt (string-append label_dir "xml/info/" name ".xinf"))
  206.  
  207.    (syntax_to_metrical_words utt)
  208.    (extend_tree 
  209.     utt (list 'MetricalTree 'MetricalWord 'WordStructure 'Syllable))
  210.    (extend_tree 
  211.     utt (list 'ProsodicTree 'MetricalTree 'SylStructure 'Segment))
  212.  
  213.    (add_match_features utt)
  214.    utt)
  215. )
  216.  
  217. (define (wsi_build utt file pathname do_il)
  218.  
  219.    (add_trans_word utt (string-append pathname "wrd/" file ".wrd"))
  220.    (add_trans_segment utt (string-append pathname "lab/" file ".lab"))
  221.    (if do_il
  222.        (add_trans_intonation utt (string-append pathname "tilt/" file ".tilt"))
  223.        nil
  224.        )
  225.    utt
  226. )
  227.  
  228. (define (make_utt_classic name relations)
  229.   "(make_utt_classic name relations)
  230. Build utterance in classic style for name and named relations."
  231.   (let (utt)
  232.     (if with_tokens
  233.     (set! utt (utt.load 
  234.            nil
  235.            (string-append label_dir "/" "Token" "/" name ".Token")))
  236.     (set! utt (Utterance Text nil)))
  237.     (set! current_utt utt)
  238.     (mapcar
  239.      (lambda (s) 
  240.        (utt.relation.load 
  241.     utt (car s) (string-append label_dir "/" 
  242.                    (car s) "/" name "." (car s))))
  243.      relations)
  244.     ;; Now link them 
  245.     (make_syl_structure utt)
  246.     (make_target_links utt)
  247.     (make_phrase_structure utt)
  248.     (if tilt_events
  249.     (tilt_link_syls utt)
  250.     (intevent_link_syls utt))
  251.  
  252.     (if with_tokens
  253.     (relate_tokens_to_words utt))
  254.     (make_utts_user_function utt)
  255.     utt)
  256. )
  257.  
  258. (define (find_pos utt)
  259.   "(find pos utt)
  260. Assign part of speech using standard POS tagger.  Also produce
  261. standard reduced tagset in phr_pos.  Irrelevant extra POS features
  262. are removed.  This assumes a POS tagger is set up at this point,
  263. this can most easily be done be setting up a relevant voice."
  264.   (POS utt)
  265.   (mapcar 
  266.    (lambda (w)
  267.      (item.set_feat 
  268.       w "phr_pos" 
  269.       (map_pos (item.feat w "pos") english_pos_map_wp39_to_wp20))
  270.      (item.remove_feature w "pos_index")
  271.      (item.remove_feature w "pos_index_score")
  272.      )
  273.    (utt.relation.items utt 'Word))
  274.   utt)
  275.  
  276. (define (map_pos pos map)
  277.   (cond
  278.    ((null map) pos)
  279.    ((member_string pos (car (car map)))
  280.     (car (cdr (car map))))
  281.    (t
  282.     (map_pos pos (cdr map)))))
  283.  
  284. (define (make_target_links utt)
  285.   "(make_target_links utt)
  286. Make targets that fall within a segment.  Targets contains all segments
  287. and have that actual Targets as daughters."
  288.   (let ((targets (utt.relation.items utt 'Target))
  289.     (segs (utt.relation.items utt 'Segment))
  290.     tt1)
  291.     (utt.relation.create utt 'TTarget)
  292.     (mapcar
  293.      (lambda (tt) 
  294.        (set! tt1 (utt.relation.append utt 'TTarget))
  295.        ;; covert the target values to the newer naming convention
  296.        (item.set_feat tt1 "pos" (item.feat tt "end"))
  297.        (item.set_feat tt1 "f0" (parse-number (item.feat tt "name")))
  298.        (item.relation.remove tt 'Target))
  299.      targets)
  300.     (set! targets (utt.relation.items utt 'TTarget))
  301.     (set! TARGSEGFACTOR 0.010)
  302.     (while segs
  303.      (utt.relation.append utt 'Target (car segs))
  304.      (while (and targets (< (item.feat (car targets) "pos")
  305.               (+ (item.feat (car segs) "end")
  306.                  TARGSEGFACTOR)))
  307.        (item.relation.append_daughter (car segs) 'Target (car targets))
  308.        (set! targets (cdr targets)))
  309.      (set! segs (cdr segs)))
  310.     (utt.relation.delete utt 'TTarget)
  311. ))
  312.     
  313.  
  314. (define (make_phrase_structure utt)
  315.   "(make_phrase_structure utt)
  316. Add words into phrases."
  317.   (let ((phrases (utt.relation.items utt 'Phrase))
  318.     (words (utt.relation.items utt 'Word)))
  319.     (set! WORDPHRASEFACTOR 0.200)
  320.     (while phrases
  321.      (while (and words (< (item.feat (car words) 'end)
  322.               (+ (item.feat (car phrases) 'end)
  323.                  WORDPHRASEFACTOR)))
  324.        (item.relation.append_daughter (car phrases) 'Phrase (car words))
  325.        (set! words (cdr words)))
  326.      (set! phrases (cdr phrases)))))
  327.  
  328. (define (relate_tokens_to_words utt)
  329. "(relate_tokens_to_words utt)
  330. A specific function for aligning the token stream to word stream."
  331.  (convert_token_stream utt)
  332.  (let ((tokens (utt.relation.items utt 'Token))
  333.        (words (utt.relation.items utt 'Word)))
  334.    (link_tokens_words tokens words)
  335.    utt)
  336. )
  337.  
  338. (define (convert_token_stream utt)
  339.   "(convert_token_stream utt)
  340. Replace Token Stream with Token relation. -- won't be needed when things
  341. are properly converted."
  342.   (utt.relation.create utt 'Token)
  343.   (mapcar
  344.    (lambda (tok) 
  345.      (utt.relation.append utt 'Token tok))
  346.    (utt.stream utt 'Token))
  347.   (utt.stream.delete utt 'Token)
  348.   )
  349.  
  350. (define (link_tokens_words tokens words)
  351.   "(link_tokens_words tokens words)
  352. Advance through the tokens and words aligning them as required."
  353.   (cond
  354.    ((null words)
  355.     t)
  356.    ((null tokens)
  357.     (error (format nil "Extra words: %l\n" (mapcar item.name words))))
  358.    ((or (string-equal "1"
  359.           (item.feat (car tokens) "punct-elem"))
  360.     (member_string (item.name (car tokens))
  361.                '("(" ")")))
  362.     (link_tokens_words (cdr tokens) words))
  363.    ((string-equal "SPEECH-OMITTED"
  364.           (item.feat (car tokens) "R:SOLEML.parent.TYPE"))
  365.     (link_tokens_words (cdr tokens) words))
  366.    ((and (string-matches (item.name (car words)) ".*'.*")
  367.      (string-equal "APOSTROPHE"
  368.                (item.feat (car tokens) "R:Token.n.TYPE")))
  369.     (item.relation.append_daughter (car tokens) 'Token (car words))
  370.     (item.relation.append_daughter (car (cdr tokens)) 'Token (car words))
  371.     (if (string-matches (item.name (car words)) ".*'")
  372.     (link_tokens_words (cdr (cdr tokens)) (cdr words))
  373.     (begin
  374.       (item.relation.append_daughter 
  375.        (car (cdr (cdr tokens))) 'Token (car words))
  376.       (link_tokens_words (cdr (cdr (cdr tokens))) (cdr words)))))
  377.    ((string-equal (downcase (item.name (car tokens)))
  378.           (downcase (item.name (car words))))
  379.     (item.relation.append_daughter (car tokens) 'Token (car words))
  380.     (link_tokens_words (cdr tokens) (cdr words)))
  381.    ;; there going to be more here !!!
  382.    (t
  383.     (error (format nil "Mismatch of tokens and words \n  %l\n  %l\n"
  384.            (mapcar item.name tokens)
  385.            (mapcar item.name words))))))
  386.  
  387. (define (do_utt name)
  388.   (let ((utt (make_utt name basic_relations)))
  389.     (utt.save utt (string-append utt_dir "/" name ".utt") 'est_ascii)
  390.     t))
  391.  
  392. (define (make_syl_structure utt)
  393.   "(make_syl_structure utt)
  394. Make SylStructure relation linking Words, Syllables and Segments."
  395.   (let ((words (utt.relation.items utt 'Word))
  396.     (syls (utt.relation.items utt 'Syllable))
  397.     (segs (utt.relation.items utt 'Segment)))
  398.     (set! SYLWORDFACTOR 0.025)
  399.     (set! SEGSYLFACTOR 0.02)
  400.     (utt.relation.create utt 'SylStructure)
  401.     (while words
  402.      (utt.relation.append utt 'SylStructure (car words))
  403.      (while (and syls (< (item.feat (car syls) 'end)
  404.              (+ (item.feat (car words) 'end)
  405.                 SYLWORDFACTOR)))
  406.        (item.relation.append_daughter (car words) 'SylStructure (car syls))
  407.        (while (and segs (< (item.feat (car segs) 'end)
  408.              (+ (item.feat (car syls) 'end)
  409.                 SEGSYLFACTOR)))
  410.     (if (not (phone_is_silence (item.name (car segs))))
  411.         (item.relation.append_daughter 
  412.          (car syls) 'SylStructure (car segs)))
  413.     (set! segs (cdr segs)))
  414.        (set! syls (cdr syls)))
  415.      (set! words (cdr words)))))
  416.  
  417. (define (tilt_link_syls utt)
  418. "(tilt_link_syls utt)
  419. Link syls to IntEvents, for Tilt.  In this case the feature syllink 
  420. specifies the word.sylnum that the event should be linked to."
  421.   (let ((syls (utt.relation.items utt 'Syllable)))
  422.     (utt.relation.create utt 'Intonation)
  423.     (mapcar 
  424.      (lambda (ie)
  425.        (let ((name (item.name ie))
  426.          (syllink (item.feat ie "syllink"))
  427.          syl)
  428.      (cond
  429.       ((member_string name '("phrase_start" "phrase_end"))
  430.        ;; relate this IntEvent to silence segment
  431. ;       (if (string-equal name "phrase_start")
  432. ;           (set! syl (find_ie_phrase_syl utt ie 'syllable_start))
  433. ;           (set! syl (find_ie_phrase_syl utt ie 'syllable_end)))
  434. ;       (utt.relation.append utt 'Intonation syl)
  435. ;       (item.relation.append_daughter syl 'Intonation ie)
  436.        )
  437.       ((and (string-equal (item.feat ie "int_event") "1")
  438.         (set! syl (find_related_syl utt syls syllink)))
  439.        (if (not (member 'Intonation (item.relations syl)))
  440.            (utt.relation.append utt 'Intonation syl))
  441.        (item.relation.append_daughter syl 'Intonation ie)
  442.        (set_rel_peak_pos utt ie syl)))))
  443.      (utt.relation.items utt 'IntEvent))  ;; the IntEvents
  444.      ))
  445.  
  446. (define (intevent_link_syls utt)
  447. "(intevent_link_syls utt)
  448. Non-tilt link of syllables to intevents through the Intonation relation."
  449.   (let ((syls (utt.relation.items utt 'Syllable)))
  450.     (utt.relation.create utt 'Intonation)
  451.     (mapcar 
  452.      (lambda (ie)
  453.        (let ((syl (find_container_syl ie syls)))
  454.      (if (not (member 'Intonation (item.relations syl)))
  455.          (utt.relation.append utt 'Intonation syl))
  456.      (item.relation.append_daughter syl 'Intonation ie)))
  457.      (utt.relation.items utt 'IntEvent))  ;; the IntEvents
  458.      ))
  459.  
  460. (define (find_container_syl ie syls)
  461.   "(find_container_syl ie syls)
  462. Find the syl thats cloests to the time on this ie."
  463.  (let ((pos (item.feat ie 'end))
  464.        (ss syls)
  465.        syl)
  466.    (while (and ss (not syl))
  467.      (let ((ss_start (item.feat (car ss) 'syllable_start))
  468.        (ss_end (item.feat (car ss) 'syllable_end)))
  469.        (if (and (> pos ss_start)
  470.         (< pos (+ ss_end 0.030)))
  471.        (set! syl (car ss)))
  472.        (set! ss (cdr ss))))
  473.    (if (not syl)
  474.        (error "Failed to find related syllable for IntEvent at" pos))
  475.    syl))
  476.  
  477. (define (find_ie_phrase_syl utt ie direction)
  478. "(find_ie_phrase_syl utt ie pos direction)
  479. Find the syllable that should be related to this IntEvent.
  480. As at this stage no real relations can be relied on this blindly
  481. searches the Syllable stream for a segment at the right time
  482. point."
  483.  (let ((syls (utt.relation.items utt 'Syllable))
  484.        (pos (item.feat ie 'position))
  485.        syl)
  486.    (while (and syls (not syl))
  487.      (if (or (approx-equal? pos (item.feat (car syls) direction) 0.04)
  488.          (and (not (item.relation.next ie 'IntEvent))
  489.           (not (cdr syls))))
  490.      (set! syl (car syls)))
  491.      (set! syls (cdr syls)))
  492.    (if (not syl)
  493.        (error "Failed to find related syllable for phrase IntEvent at" pos))
  494.    syl))
  495.  
  496. (define (set_rel_peak_pos utt ie syl)
  497. "(set_rel_peak_pos ie syl)
  498. Set the feature tilt:rel_pos to the distance from the start of 
  499. of the vowel in syl"
  500.  (item.set_feat
  501.   ie
  502.   "tilt:rel_pos"
  503.   (- (- (item.feat ie 'end)
  504.     (* (- 1.0 (item.feat ie 'tilt:tilt))
  505.        (item.feat ie 'tilt:dur) 
  506.        0.5))
  507.      (syl_vowel_start syl))))
  508.  
  509. (define (find_related_syl utt syls syllink)
  510. "(find_related_syl utt syls syllink)
  511. Find the syllable name by sylllink, which is of the form x[.y].
  512. x the word number and y is the syllable number."
  513.   (unwind-protect 
  514.    (let (wordlab sylnum word syls syl)
  515.      (if (string-matches syllink ".*\\..*")
  516.      (begin 
  517.        (set! wordlab (string-before syllink "."))
  518.        (set! sylnum (- (parse-number (string-after syllink ".")) 1)))
  519.      (begin 
  520.        (set! wordlab syllink)
  521.        (set! sylnum 0)))
  522.      (set! word (find_word_labelled 
  523.          utt (utt.relation.items utt 'Word) wordlab))
  524.      (if (not word)
  525.      (error "Failed to find word labelled:" wordlab))
  526.      (set! syls (item.relation.daughters word 'SylStructure))
  527.      (set! syl (nth sylnum syls))
  528.      (if syl 
  529.      syl
  530.      (car (last syls))))
  531.    (begin
  532.      (error "Failed to find syllable labelled:" syllink))))
  533.  
  534. (define (find_word_labelled utt words lab)
  535. "(find_word_labelled words lab)
  536. Find the word whose label is lab."
  537.  (cond
  538.   ((null words) nil)
  539.   ((string-equal lab (item.feat (car words) "wordlab"))
  540.    (car words))
  541.   (t
  542.    (find_word_labelled utt (cdr words) lab))))
  543.  
  544. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  545. ;;;   The main work
  546. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  547. (define (main)
  548.   (get_options)
  549.  
  550.   (mapcar
  551.    (lambda (f)
  552.      (format t "%s\n" f)
  553.      (unwind-protect
  554.       (do_utt (path-basename f))
  555.       (format stderr "utterance build or save failed\n")))
  556.    seg_files))
  557.  
  558. (main)
  559.