47 #include "ling_class/EST_Utterance.h"
48 #include "ling_class/EST_Item.h"
49 #include "EST_THash.h"
51 #include "EST_wave_aux.h"
52 #include "EST_Track.h"
53 #include "EST_track_aux.h"
55 Declare_TStringHash_Base(LISP,(LISP)0,NIL)
57 #if defined(INSTANTIATE_TEMPLATES)
58 #include "../base_class/EST_THash.cc"
60 Instantiate_TStringHash(LISP)
75 static void void_to_addrname(
const void *v,
EST_String &saddr)
87 static int tc_utt = -1;
88 static int tc_val = -1;
95 err(
"wrong type of argument to get_c_utt",x);
100 int utterance_p(LISP x)
114 void_to_addrname(u,saddr);
116 if ((cell = estobjs.val(saddr)) != NIL)
120 utt = siod_make_typed_cell(tc_utt,(
void *)u);
123 estobjs.add_item(saddr,utt);
128 static void utt_free(LISP lutt)
133 void_to_addrname(u,saddr);
138 estobjs.remove_item(saddr);
142 USERVAL(lutt) = NULL;
145 LISP utt_mark(LISP utt)
156 return *((
class EST_Val *)x->storage_as.val.v);
159 err(
"wrong type of argument to get_c_val",x);
166 LISP val_equal(LISP a,LISP b)
168 if (val(a) == val(b))
182 LISP siod(
const class EST_Val v)
184 return siod_make_typed_cell(tc_val,
new EST_Val(v));
187 static void val_free(LISP val)
194 static void val_prin1(LISP v, FILE *fd)
198 fput_st(fd,val(v).
type());
199 sprintf(b,
" %p",val(v).internal_ptr());
204 static void val_print_string(LISP v,
char *tkbuffer)
206 sprintf(tkbuffer,
"#<%s %p>",val(v).
type(),val(v).internal_ptr());
222 val_type val_type_scheme = "scheme";
223 struct obj_val {LISP l;};
226 if (v.
type() == val_type_scheme)
227 return ((obj_val *)v.internal_ptr())->l;
229 EST_error(
"val not of type val_type_scheme");
232 static void val_delete_scheme(
void *v)
234 struct obj_val *ov = (
struct obj_val *)v;
235 gc_unprotect(&ov->l);
241 struct obj_val *ov = walloc(
struct obj_val,1);
242 ov->l = (LISP)(
void *)v;
244 return EST_Val(val_type_scheme,
249 LISP lisp_val(
const EST_Val &pv)
251 if (pv.
type() == val_unset)
253 cerr <<
"EST_Val unset, can't build lisp value" << endl;
257 else if (pv.
type() == val_int)
258 return flocons(pv.
Int());
259 else if (pv.
type() == val_float)
260 return flocons(pv.
Float());
261 else if (pv.
type() == val_string)
263 else if (pv.
type() == val_type_scheme)
265 else if (pv.
type() == val_type_feats)
266 return features_to_lisp(*feats(pv));
271 static int feature_like(LISP v)
274 if ((v == NIL) || (!consp(v)))
279 for (p=v; p != NIL; p=cdr(p))
281 if (!consp(p) || (!consp(car(p))) || (consp(car(car(p)))))
293 lisp_to_features(v,*f);
297 return EST_Val(get_c_float(v));
298 else if (TYPEP(v,tc_val))
300 else if (TYPEP(v,tc_symbol) || (TYPEP(v,tc_string)))
312 for(p.begin(kvl); p; ++p)
314 l=cons(cons(rintern(p->k),
315 cons(lisp_val(p->v),NIL)),
326 for (p=l; p; p = cdr(p))
327 kvl.
add_item(get_c_string(car(car(p))),
328 get_c_string(car(cdr(car(p)))));
337 for(p.
begin(f); p; ++p)
339 lf=cons(cons(rintern(p->k),
340 cons(lisp_val(p->v),NIL)),
351 for (p=lf; p; p = cdr(p))
352 f.
set_val(get_c_string(car(car(p))),
353 val_lisp(car(cdr(car(p)))));
356 static LISP feats_set(LISP lfeats, LISP fname, LISP val)
365 feats(lf)->set_path(get_c_string(fname),val_lisp(val));
369 static LISP feats_get(LISP f, LISP fname)
371 return lisp_val(feats(f)->val_path(get_c_string(fname)));
374 static LISP feats_make()
380 static LISP feats_tolisp(LISP lf)
382 return features_to_lisp(*feats(lf));
385 static LISP feats_remove(LISP lf, LISP fname)
388 f->
remove(get_c_string(fname));
392 static LISP feats_present(LISP lf, LISP fname)
395 if (f->
present(get_c_string(fname)))
403 EST_Features *f = feats(siod_get_lval(
"Param",
"No Param features set"));
423 tc_utt = siod_register_user_type(
"Utterance");
424 set_gc_hooks(tc_utt, 0, NULL,utt_mark,NULL,utt_free,NULL,&kind);
426 tc_val = siod_register_user_type(
"Val");
427 set_gc_hooks(tc_val, 0, NULL,NULL,NULL,val_free,NULL,&kind);
428 set_print_hooks(tc_val,val_prin1,val_print_string);
429 set_type_hooks(tc_val,NULL,val_equal);
431 init_subr_2(
"feats.get",feats_get,
432 "(feats.get FEATS FEATNAME)\n\
433 Return value of FEATNAME (which may be a simple feature name or a\n\
434 pathname) in FEATS. If FEATS is nil a new feature set is created");
435 init_subr_3(
"feats.set",feats_set,
436 "(feats.set FEATS FEATNAME VALUE)\n\
437 Set FEATNAME to VALUE in FEATS.");
438 init_subr_2(
"feats.remove",feats_remove,
439 "(feats.remove FEATS FEATNAME)\n\
440 Remove feature names FEATNAME from FEATS.");
441 init_subr_2(
"feats.present",feats_present,
442 "(feats.present FEATS FEATNAME)\n\
443 Return t is FEATNAME is present in FEATS, nil otherwise.");
444 init_subr_0(
"feats.make",feats_make,
446 Return an new empty features object.");
447 init_subr_1(
"feats.tolisp",feats_tolisp,
448 "(feats.tolisp FEATS)\n\
449 Gives a lisp representation of the features, this is a debug function\n\
450 and may or may not exist tomorrow.");