;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                     ;;;
;;;                  Language Technologies Institute                    ;;;
;;;                     Carnegie Mellon University                      ;;;
;;;                      Copyright (c) 2007-2014                        ;;;
;;;                        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: November 2007                                   ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                     ;;;
;;; Convert a clustergen voice to flite                                 ;;;
;;; (Oct 2014) support for random forests                                ;;;
;;;                                                                     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Used for getting smaller models, if non-zero this will reduce the 
;; order of the dumped models from whatever it is (probably 24) to this
;; It does the right thing with statics and dynamics and stddev
(defvar cg:relevant_params nil) ;; a list of param ranges to dump
(defvar cg_reduced_order 0)
(if (> cg_reduced_order 0) ;; just to remind me
    (format t "\n***** CG: note reducing order to %d *****\n\n" 
            cg_reduced_order))
(defvar F0MEAN 0.0)
(defvar F0STD 1.0)
(defvar num_channels_additive_constant 4)

(define (cg_convert name festvoxdir odir)
  "(cg_convert name clcatfn clcatfnordered cltreesfn festvoxdir odir)
Convert a festvox clunits (processed) voice into a C file."

   (load (format nil "%s/festvox/%s_cg.scm" festvoxdir name))
   (eval (list (intern (format nil "voice_%s_cg" name))))

   (set! ofd (fopen (path-append odir (string-append name "_cg.c")) "w"))
   (format ofd "/*****************************************************/\n")
   (format ofd "/**  Autogenerated clustergen voice for %s    */\n" name)
   (format ofd "/*****************************************************/\n")
   (format ofd "\n")
   (format ofd "#include \"cst_string.h\"\n")
   (format ofd "#include \"cst_cg.h\"\n")
   (format ofd "#include \"cst_cart.h\"\n")

   (format t "cg_convert: converting F0 trees\n")
   ;; F0 trees
   (set! val_table nil) ;; different val number over the two sets of carts
   (cg_convert_carts 
    (load (format nil "festival/trees/%s_f0.tree" name) t)
    "f0" name odir)
   (format ofd "\n")
   (format ofd "extern const cst_cart * const %s_f0_carts[];\n" name )

   (if cg:spamf0
	(begin
	  (set! acctrack (track.load "festival/trees/cb.params"))
	  (format ofd "extern const cst_cart %s_spamf0_phrase_cart;\n" name)
	  (format ofd "extern const cst_cart %s_spamf0_accent_cart;\n" name)
	  (format ofd "extern const float * const %s_spamf0_accent_vectors[];\n" name)
	  (format ofd "#define %s_spamf0_accent_num_channels %d\n" name (track.num_channels acctrack))
	  (format ofd "#define %s_spamf0_accent_num_frames %d\n" name (track.num_frames acctrack))
	))

   ;; spectral trees
   (set! val_table nil) ;; different val number over the two sets of carts

   (if cg:rfs_models
       (set! pms (load "rf_models/mlist" t))
       (set! pms (list '01)))

   (if cg:rfs_models
       (begin ;; Random Forest Spectral Models 
         (format t "cg_convert: converting rf spectral trees\n")
         (mapcar
          (lambda (pm)
            (set! old_carttoC_extract_answer carttoC_extract_answer)
            (set! carttoC_extract_answer carttoC_extract_spectral_frame)
            (set! val_table nil)
            (cg_convert_carts 
             (load (format nil "rf_models/trees_%02d/%s_mcep.tree" pm name) t)
             (format nil "%02d_mcep" pm) name odir)
            (set! carttoC_extract_answer old_carttoC_extract_answer)
            (format ofd "\n")
            (format ofd "extern const cst_cart * const %s_%02d_mcep_carts[];\n" name pm)

            ;; spectral params
            (format t "cg_convert:   converting model_%02d spectral params\n" pm)
            (cg_convert_params
             (format nil "rf_models/trees_%02d/%s_mcep.params" pm name)
             (format nil "festival/trees/%s_min_range.scm" name)
             name (format nil "%02d" pm) odir ofd)
         (format ofd "extern const unsigned short * const %s_%02d_model_vectors[];\n" name pm ))
          pms))
       (begin ;; Non-random forest spectral models (one model)
         (format t "cg_convert: converting single spectral trees\n")
         (set! old_carttoC_extract_answer carttoC_extract_answer)
         (set! carttoC_extract_answer carttoC_extract_spectral_frame)
         (set! val_table nil)
         (cg_convert_carts 
          (load (format nil "festival/trees/%s_mcep.tree" name) t)
          "01_mcep" name odir)
         (set! carttoC_extract_answer old_carttoC_extract_answer)
         (format ofd "\n")
         (format ofd "extern const cst_cart * const %s_01_mcep_carts[];\n" name )
         ;; spectral params
         (format t "cg_convert:    converting model_01 spectral params\n")
         (cg_convert_params
          (format nil "festival/trees/%s_mcep.params" name)
          (format nil "festival/trees/%s_min_range.scm" name)
          name "01" odir ofd)
         (format ofd "extern const unsigned short * const %s_01_model_vectors[];\n" name )
         ))

   (format ofd "#define %s_num_param_models %d\n" name (length pms))
   (format ofd "const int %s_num_channels_table[] = {\n" name)
   (mapcar
    (lambda (pm)
      (format ofd "   %s_%02d_num_channels,\n" name pm))
    pms)
   (format ofd "0};\n")
   (format ofd "const int %s_num_frames_table[] = {\n" name)
   (mapcar
    (lambda (pm)
      (format ofd "   %s_%02d_num_frames,\n" name pm))
    pms)
   (format ofd "0};\n")
   (format ofd "const unsigned short **%s_model_vectors_table[] = {\n" name)
   (mapcar
    (lambda (pm)
      (format ofd "   %s_%02d_model_vectors,\n" name pm))
    pms)
   (format ofd "NULL};\n")
   (format ofd "const cst_cart **%s_mcep_carts_table[] = {\n" name)
   (mapcar
    (lambda (pm)
      (format ofd "   %s_%02d_mcep_carts,\n" name pm))
    pms)
   (format ofd "NULL};\n")
    
   ;; duration model (cart conversion)
   (if cg:rfs_dur_models
       (set! dms (load "dur_rf_models/mlist" t))
       (set! dms '(01)))

   (if cg:rfs_dur_models
       (begin
         (format t "cg_convert: converting rf duration models\n")
         (mapcar 
             (lambda (dm)
               (format t "cg_convert:    converting %02d duration model\n" dm)
               (set! val_table nil)
               (cg_convert_durmodel
                (format nil "dur_rf_models/dur_%02d/%s_durdata_cg.scm" dm name)
                (format nil "%s_cg_%02d_" name dm) odir)
               (format ofd "extern const dur_stat * const %s_cg_%02d_dur_stats[];\n" name dm)
              (format ofd "extern const cst_cart %s_cg_%02d_dur_cart;\n" name dm))
             dms))
       (begin
         (format t "cg_convert: converting single duration model\n")
         (format t "cg_convert:    converting 01 duration model\n")
         (cg_convert_durmodel
          (format nil "festvox/%s_durdata_cg.scm" name)
          (format nil "%s_cg_%02d_" name 01) odir)
         (format ofd "extern const dur_stat * const %s_cg_%02d_dur_stats[];\n" name 01)
         (format ofd "extern const cst_cart %s_cg_%02d_dur_cart;\n" name 01)
       ))

   (format ofd "#define %s_num_dur_models %d\n" name (length dms))
   (format ofd "const dur_stat **%s_dur_stats_table[] = {\n" name)
   (mapcar
    (lambda (dm)
      (format ofd "   %s_cg_%02d_dur_stats,\n" name dm))
    dms)
   (format ofd "NULL};\n")
   (format ofd "const cst_cart *%s_dur_cart_table[] = {\n" name)
   (mapcar
    (lambda (dm)
      (format ofd "   &%s_cg_%02d_dur_cart,\n" name dm))
    dms)
   (format ofd "NULL};\n")

   ;; phone to states
   (format t "cg_convert: converting phone to state map\n")
   (cg_phone_to_states 
    (format nil "festvox/%s_statenames.scm" name)
    name odir)
   (format ofd "extern const char * const *%s_phone_states[];\n" name)

   (format ofd "\n")
   (format ofd "const char * const %s_types[] = {\n" name)
   (mapcar
    (lambda (cart)
      (format ofd "   \"%s\",\n" (car cart)))
    (load (format nil "festival/trees/%s_f0.tree" name) t))
   (format ofd "   NULL};\n")
   (format ofd "#define %s_num_types  %d\n\n"
           name
           (length (load (format nil "festival/trees/%s_f0.tree" name) t)))

   (format ofd "const float %s_model_min[] = { \n" name)
   (mapcar
    (lambda (p)
      (format ofd "   %f,\n" (car p)))
    (reverse new_min_range))
   (format ofd "};\n")
   (format ofd "const float %s_model_range[] = { \n" name)
   (mapcar
    (lambda (p)
      (format ofd "   %f,\n" (cadr p)))
    (reverse new_min_range))
   (format ofd "};\n")

   (format ofd "const float %s_dynwin[] = { -0.5, 0.0, 0.5 };\n" name)
   (format ofd "#define %s_dynwinsize 3\n" name)

   (if cg:mixed_excitation
       (begin
         ;; Uses filters in festvox/mef.track (from Jan 2013)
         (set! n 0)
         (while (< n 5)
            (format ofd "const double %s_me_filter_%d[] = {\n" name n)
            (set! o 0)
            (while (< o 46)
               (format ofd "%f, " (track.get me_filter_track n o))
               (set! o (+ o 1)))
            (format ofd "%f\n};\n" (track.get me_filter_track n o))
            (set! n (+ n 1))
         )
         (format ofd "const double * const %s_me_h[] = {\n" name)
         (format ofd "   %s_me_filter_0,\n" name)
         (format ofd "   %s_me_filter_1,\n" name)
         (format ofd "   %s_me_filter_2,\n" name)
         (format ofd "   %s_me_filter_3,\n" name)
         (format ofd "   %s_me_filter_4\n" name)
         (format ofd "};\n\n")
         ))

   (format ofd "const cst_cg_db %s_cg_db = {\n" name)
   (format ofd "  \"%s\",\n" name)
   (format ofd "  %s_types,\n" name)
   (format ofd "  %s_num_types,\n" name)
   (if (boundp 'framerate)
       (format ofd "  %d,\n" framerate) ;; sample rate
       (format ofd "  16000,\n"))       ;; sample rate

   (format ofd "  %f,%f,\n" F0MEAN F0STD) 

   (format ofd "  %s_f0_carts,\n" name)
   (format ofd "  %s_num_param_models,\n" name)
   (format ofd "  %s_mcep_carts_table,\n" name)
   (if cg:spamf0
       (begin
         (set! mfd (fopen (path-append odir "paramfiles.mak") "a"))
         (format mfd "SPAMF0=true\n")
         (fclose mfd)
         (format ofd "  &%s_spamf0_accent_cart,\n" name)
         (format ofd "  &%s_spamf0_phrase_cart,\n" name)
         )
       (begin
         (set! mfd (fopen (path-append odir "paramfiles.mak") "a"))
         (format mfd "SPAMF0=false\n")
         (fclose mfd)
         (format ofd "  NULL,NULL,\n")
         )
       )
   (format ofd "  %s_num_channels_table,\n" name)
   (format ofd "  %s_num_frames_table,\n" name)
   (format ofd "  %s_model_vectors_table,\n" name)

   (if cg:spamf0
       (begin
         (format ofd "  %s_spamf0_accent_num_channels,\n" name)
         (format ofd "  %s_spamf0_accent_num_frames,\n" name)
         (format ofd "  %s_spamf0_accent_vectors,\n" name)
         )
       (format ofd "  0,0,NULL,\n")
       )
   (format ofd "  %s_model_min,\n" name)
   (format ofd "  %s_model_range,\n" name)
   (format ofd "  %f, /* frame_advance */\n" cg:frame_shift)

   (format ofd "  %s_num_dur_models,\n" name)
   (format ofd "  %s_dur_stats_table,\n" name)
   (format ofd "  %s_dur_cart_table,\n" name)
   (format ofd "  %s_phone_states,\n" name)

   (format ofd "  1, /* 1 if mlpg required */\n")
   (format ofd "  %s_dynwin,\n" name)
   (format ofd "  %s_dynwinsize,\n" name)

   (format ofd "  %f, /* mlsa_alpha */\n" mlsa_alpha_param)
   (format ofd "  %f, /* mlsa_beta */\n" 0.4)

   (if cg:multimodel
       (format ofd "  1, /* cg:multimodel */\n")
       (format ofd "  0, /* cg:multimodel */\n"))

   (if cg:mixed_excitation
       (begin
         (format ofd "  1, /* cg:mixed_excitation */\n")
         (format ofd "  5,48, /* filter sizes */\n")
         (format ofd "  %s_me_h, \n" name))
       (begin
         (format ofd "  0, /* cg:mixed_excitation */\n")
         (format ofd "  0,0, /* cg:mixed_excitation */\n")
         (format ofd "  NULL, \n")))
   (if cg:spamf0
	(format ofd "  1, // cg:spamf0\n")
	(format ofd "  0, // cg:spamf0\n"))
   (format ofd "  1.5 /* gain */\n")
   (format ofd "};\n")

   (fclose ofd)
)

(define (unit_type u)
  (apply
   string-append
   (reverse
    (symbolexplode 
     (string-after 
      (apply
       string-append
       (reverse (symbolexplode u)))
      "_")))))

(define (unit_occur u)
  (apply
   string-append
   (reverse
    (symbolexplode 
     (string-before
      (apply
       string-append
       (reverse (symbolexplode u)))
      "_")))))

(define (cg_convert_durmodel durmodelfn name odir)

  (set! durmodel (load durmodelfn t))
  (set! phonedurs (cadr (car (cddr (car durmodel)))))
  (set! zdurtree (cadr (car (cddr (cadr durmodel)))))

  (set! dfd (fopen (path-append odir (string-append name "durmodel.c")) "w"))
  (set! dfdh (fopen (path-append odir (string-append name "durmodel.h")) "w"))
  (format dfd "/*****************************************************/\n")
  (format dfd "/**  Autogenerated durmodel_cg for %s    */\n" name)
  (format dfd "/*****************************************************/\n")

  (format dfd "#include \"cst_synth.h\"\n")
  (format dfd "#include \"cst_string.h\"\n")
  (format dfd "#include \"cst_cart.h\"\n")
  (format dfd "#include \"%sdurmodel.h\"\n\n" name)

  (mapcar
   (lambda (s)
     (format dfd "static const dur_stat dur_state_%s = { \"%s\", %f, %f };\n"
             (cg_normal_phone_name (car s)) 
             (car s) (car (cdr s)) (car (cddr s)))
     )
   phonedurs)
  (format dfd "\n")

  (format dfd "const dur_stat * const %sdur_stats[] = {\n" name)
  (mapcar
   (lambda (s)
     (format dfd "   &dur_state_%s,\n" (cg_normal_phone_name (car s))))
   phonedurs)  
  (format dfd "   NULL\n};\n")

  (set! val_table nil)
  (set! current_node -1)
  (set! feat_nums nil)
  (do_carttoC dfd dfdh 
              (format nil "%s%s" name "dur")
              zdurtree)

  (fclose dfd)
  (fclose dfdh)
)

(define (cg_phone_to_states phonestatefn name odir)

  (set! dfd (fopen (path-append odir (string-append name "_cg_phonestate.c")) "w"))
  (format dfd "/*****************************************************/\n")
  (format dfd "/**  Autogenerated phonestate_cg for %s    */\n" name)
  (format dfd "/*****************************************************/\n")

  (set! phonestates (load phonestatefn t))

  (mapcar
   (lambda (x)
     (format dfd "const char * const %s_%s_ps[] = { " name 
             (cg_normal_phone_name (car x)))
     (mapcar 
      (lambda (y) (format dfd "\"%s\", " y))
      x)
     (format dfd " 0};\n"))
   (cadr (caddr (car phonestates))))

  (format dfd "const char * const * const %s_phone_states[] = {\n" name)
  (mapcar
   (lambda (x)
     (format dfd "   %s_%s_ps,\n" name 
             (cg_normal_phone_name (car x))))
   (cadr (caddr (car phonestates))))
  (format dfd "   0};\n")

  (fclose dfd)
)

(define (cg_convert_params mcepfn mcepminrangefn name type odir cofd)
  (let ((param.track (track.load mcepfn))
        (i 0) (mfd))

    (set! mfd (fopen (path-append odir (string-append name "_cg_" type "_params.c")) "w"))
    (format mfd "/*****************************************************/\n")
    (format mfd "/**  Autogenerated model_vectors for %s    */\n" name)
    (format mfd "/*****************************************************/\n")
    (set! num_channels (track.num_channels param.track))
    (set! num_frames (track.num_frames param.track))
    ;; Output each frame
    (set! mcep_min_range (load mcepminrangefn t))
    (while (< i num_frames)
       (output_param_frame name type param.track i mfd)      
       (set! i (+ 1 i)))
    (format mfd "\n\n")
    ;; Output each frame
    (format mfd "const unsigned short * const %s_%s_model_vectors[] = {\n" name type)
    (set! i 0)
    (while (< i num_frames)
       (format mfd "   %s_%s_param_frame_%d,\n" name type i)
       (set! i (+ 1 i)))
    (format mfd "};\n\n")

    (if cg:mixed_excitation
	(begin
	  (set! num_channels_additive_constant 14)
	  ))
    
    (if (> cg_reduced_order 0)
	(format cofd "#define %s_%s_num_channels %d\n"
		name type (+ num_channels_additive_constant (* 4 cg_reduced_order)))
	(format cofd "#define %s_%s_num_channels %d\n" name type num_channels))
    
    (format cofd "#define %s_%s_num_frames %d\n" name type num_frames)
  
    (fclose mfd)

    ))

(define (mcepcoeff_norm c min range)
  (let ((x (* (/ (- c min) range) 65535)))
    (cond
     ((< x 0) 0.0)
     ((> x 65535) 65535)
     (t x))))

(define (output_accent_frame name track f ofd)
  "(output_accent_frame name track frame ofd)
Ouput this accent params."
  (let ((i 0) (nc (track.num_channels track)))
    ;(format ofd "static const unsigned short %s_spamf0_accent_frame_%d[] = { \n" name f)
    (format ofd "static const float %s_spamf0_accent_frame_%d[] = { \n" name f)
	  (while (< i nc)
                       (format ofd " %f," (track.get track f i))
                 (set! i (+ 1 i)))
          (format ofd " };\n")
)
)

(define (output_param_frame name type track f ofd)
  "(output_param_frame name track frame ofd)
Ouput this frame."
  (let ((i 0) (nc (track.num_channels track)))
    (format ofd "static const unsigned short %s_%s_param_frame_%d[] = { \n" name type f)
    (set! min_range mcep_min_range)
    (set! real_order (/ (- nc 4) 4))
    (set! new_min_range nil)

    (if cg:relevant_params
        (begin ;; specified number of parameters
          )
    (if cg:mixed_excitation
	(begin
	  
	  (while (< i nc)
		 (if (or (eq cg_reduced_order 0)
			 (< i (* 2 (+ 1 cg_reduced_order))) ;; static and static_stddev
			 (and (> i (- (/ (- nc 10) 2) 1))  ;; deltas and delta_stddev
			      (< i (+ (/ (- nc 10) 2) (* 2 cg_reduced_order))))
			 (> i (- nc 13)))
		     (begin
					; (format t "i is %d %d\n" i (+ (/ nc 2) (* 2 cg_reduced_order)))
		       (format ofd " %d," 
			       (mcepcoeff_norm 
				(track.get track f i)
				(caar min_range)
				(cadr (car min_range))))
		       (set! new_min_range (cons (car min_range) new_min_range))
		       ))
		 (set! min_range (cdr min_range))
		 (set! i (+ 1 i)))
	  (format ofd " };\n")
	  )
	(begin
	  (while (< i nc)
                 (if (or (eq cg_reduced_order 0)
                         (< i (* 2 (+ 1 cg_reduced_order))) ;; static and static_stddev
                         (and (> i (- (/ nc 2) 1))  ;; deltas and delta_stddev
                              (< i (+ (/ nc 2) (* 2 cg_reduced_order))))
                         (> i (- nc 3)))
                     (begin
                                        ; (format t "i is %d %d\n" i (+ (/ nc 2) (* 2 cg_reduced_order)))
                       (format ofd " %d,"
                               (mcepcoeff_norm
                                (track.get track f i)
                                (caar min_range)
                                (cadr (car min_range))))
                       (set! new_min_range (cons (car min_range) new_min_range))
                       ))
                 (set! min_range (cdr min_range))
                 (set! i (+ 1 i)))
          (format ofd " };\n")
          )))
    )
  )

(define (carttoC_extract_spectral_frame ofdh tree)
  "(carttoC_extract_spectral_frame tree)
Get list of answers from leaf node."
  (carttoC_val_table ofdh 
		     (car (car tree))
		     'none))

(define (cg_convert_carts carts prefix name odir)
 "(define cg_convert_carts cartfn name)
Output cg selection carts into odir/name_carts.c"
 (let (ofd ofdh)
   ;; Set up to dump full list of things at leafs
   ;; default processing of leaf (int or float) is fine

   (set! ofd (fopen (format nil "%s/%s_cg_%s_trees.c" odir name prefix) "w"))
   (set! ofdh (fopen (format nil "%s/%s_cg_%s_trees.h" odir name prefix) "w"))
   (format ofd "/*****************************************************/\n")
   (format ofd "/**  Autogenerated %s %s carts    */\n" name prefix)
   (format ofd "/*****************************************************/\n")
   (format ofd "\n")
   (format ofd "#include \"cst_string.h\"\n")
   (format ofd "#include \"cst_cart.h\"\n")
   (format ofd "#include \"%s_cg_%s_trees.h\"\n" name prefix)

   (mapcar
    (lambda (cart)
      (if (string-equal "string" (typeof (car cart)))
          (begin
            (set! current_node -1)
            (set! feat_nums nil)
            (do_carttoC ofd ofdh 
                        (format nil "%s_%s_%s" name prefix 
                                (cg_normal_phone_name (car cart)))
                        (cadr cart)))))
    carts)
 
   (format ofd "\n\n")
   (format ofd "const cst_cart * const %s_%s_carts[] = {\n" name prefix)
   (mapcar
    (lambda (cart)
      (if (string-equal "string" (typeof (car cart)))
          (format ofd " &%s_%s_%s_cart,\n" name prefix 
                  (cg_normal_phone_name (car cart))))
      )
    carts)
   (format ofd " 0 };\n")

   (fclose ofd)
   (fclose ofdh)

   )
)

(define (cg_normal_phone_name x)
  (cg_normal_phone_name_base
   (cg_normal_phone_name_base
    (cg_normal_phone_name_base x))))

(define (cg_normal_phone_name_base x)
  ;; Some phone names aren't valid C labels
  (cond
   ((string-matches x ".*@.*" x) 
    (intern
     (string-append
      (string-before x "@")
      "atsign"
      (string-after x "@"))))
   ((string-matches x ".*:.*")
    (intern
     (string-append
      (string-before x ":")
      "sc"
      (string-after x ":"))))
   ((string-matches x ".*=.*")
    (intern
     (string-append
      (string-before x "=")
      "eq"
      (string-after x "="))))
   ((string-matches x ".*>.*")
    (intern
     (string-append
      (string-before x ">")
      "gt"
      (string-after x ">"))))
   ((string-matches x ".*}.*")
    (intern
     (string-append
      (string-before x "}")
      "rb"
      (string-after x "}"))))
   ((string-matches x ".*~.*")
    (intern
     (string-append
      (string-before x "~")
      "tilde"
      (string-after x "~"))))
   (t x)))

(provide 'make_cg)