source: golgotha/src/i4/lisp/li_class.cc @ 80

Last change on this file since 80 was 80, checked in by Sam Hocevar, 12 years ago
  • Adding the Golgotha source code. Not sure what's going to be interesting in there, but since it's all public domain, there's certainly stuff to pick up.
File size: 14.7 KB
Line 
1/********************************************************************** <BR>
2  This file is part of Crack dot Com's free source code release of
3  Golgotha. <a href="http://www.crack.com/golgotha_release"> <BR> for
4  information about compiling & licensing issues visit this URL</a>
5  <PRE> If that doesn't help, contact Jonathan Clark at
6  golgotha_source@usa.net (Subject should have "GOLG" in it)
7***********************************************************************/
8
9#include "main/main.hh"
10#include "lisp/lisp.hh"
11#include "file/file.hh"
12#include "lisp/li_types.hh"
13#include "lisp/li_class.hh"
14#include "loaders/dir_load.hh"
15#include "loaders/dir_save.hh"
16#include "lisp/li_init.hh"
17#include "lisp/li_load.hh"
18
19static li_type_edit_class *li_class_editor=0;
20
21void li_set_class_editor(li_type_edit_class *editor)
22{
23  li_class_editor=editor;
24}
25
26
27////////////////////////////// li_class_type members ///////////////////////////////////////////////
28
29li_class *li_this;
30
31class li_class_type : public li_type_function_table
32{
33public:
34
35  struct var
36  {
37    li_object  *default_value;
38    li_object  *property_list;
39    li_symbol  *sym;
40    int        original_order;
41
42    void init()
43    {
44      sym=0;
45      default_value=0;
46      property_list=0;
47      original_order=0;
48    }
49  };
50
51  static int var_compare(const var *a, const var *b);
52
53  i4_fixed_array<var> vars;
54
55  int old_tvars;
56  sw16 *value_remap;     // used during loading of a li_class
57
58  li_class_type *derived_from;
59  li_symbol *sym;
60  var *get_var(li_symbol *sym);
61
62  int type;
63
64  static li_class_type *get(li_type_function_table *o, li_environment *env)
65  {
66    li_class_type *c=(li_class_type *)o;
67#ifdef LI_TYPE_CHECK
68    if (c!=li_get_type(c->type))
69      li_error(env, "function table does not point to a class");
70#endif     
71    return c;
72  }
73
74  li_object *create(li_object *params, li_environment *env);
75
76  void mark(int set);
77  void mark(li_object   *o, int set);
78  void free(li_object   *o);
79  void print(li_object  *o, i4_file_class *stream);
80  char *name();
81
82  li_class_type(li_symbol *sym, li_class_type *derived_from) 
83    : sym(sym), derived_from(derived_from)
84  {
85    value_remap=0;
86  }
87
88
89  int get_var_offset(li_symbol *sym, int die_on_error)
90  {
91    w32 r=vars.size();
92
93    if (!r) return 0;
94    int l=0,m;
95    li_symbol *s1,*s2;
96
97    while (l<r)
98    {
99      m = (l+r)/2;
100      s1=vars[m].sym;
101
102      if (s1==sym)
103        return m;
104
105      if (sym<s1)
106        r = m;
107      else
108        l = m+1;
109    }
110
111    if (l==r || vars[l].sym!=sym)
112      if (die_on_error)
113        li_error(0, "var not in class %O", sym);
114      else return -1;
115
116    return l;
117  }
118
119  ~li_class_type()
120  {
121    vars.uninit();
122  }
123
124  // these load and save type information
125  virtual void save(i4_saver_class *fp, li_environment *env);
126  virtual void load(i4_loader_class *fp, li_type_number *type_remap,
127                    li_environment *env);
128                   
129  virtual void load_done();
130
131  // load & save type instance information
132  virtual void save_object(i4_saver_class *fp, li_object *o, li_environment *env);
133  virtual li_object *load_object(i4_loader_class *fp, li_type_number *type_remap,
134                                 li_environment *env);
135
136};
137
138
139struct sym_var
140{
141  li_class_type::var *var;
142  li_object     *value;
143};
144
145
146
147char *li_class_type::name()
148{
149  if (sym)
150    return sym->name()->value();
151  else
152    return "anonymous-class";
153}
154
155
156void li_class_type::mark(int set)
157{
158  for (int i=0; i<vars.size(); i++)
159  {
160    if (vars[i].default_value)
161      if (vars[i].default_value->is_marked()!=set)
162        li_get_type(vars[i].default_value->unmarked_type())->mark(vars[i].default_value, set);
163
164    if (vars[i].property_list)
165      if (vars[i].property_list->is_marked()!=set)
166        li_get_type(vars[i].property_list->unmarked_type())->mark(vars[i].property_list, set);
167  }     
168}
169
170void li_class::mark(int set)
171{
172  if (!set)
173    li_object::mark(set);
174
175  li_class_type *t=get_type();
176  for (int i=0; i<t->vars.size(); i++)
177  {   
178    int type=t->vars[i].default_value->unmarked_type();
179
180    li_object *o=object_value(i);
181    // int's and floats are stored directly and don't need marking
182    if (type!=LI_INT && type!=LI_FLOAT && o->is_marked()!=set)
183      li_get_type(o->unmarked_type())->mark(o, set);
184  }     
185
186  if (set)
187    li_object::mark(set);
188}
189
190li_class_type::var *li_class_type::get_var(li_symbol *sym)
191{
192  for (int i=0; i<vars.size(); i++)
193    if (vars[i].sym==sym)
194      return &vars[i];
195
196  if (derived_from)
197    return derived_from->get_var(sym);
198
199  return 0;
200}
201
202void li_class_type::mark(li_object   *o, int set)   
203
204  ((li_class *)o)->mark(set);
205}
206
207void li_class_type::free(li_object   *o)
208{
209  li_class::get(o,0)->free();
210}
211
212void li_class_type::print(li_object  *o, i4_file_class *stream)
213{
214  li_class::get(o,0)->print(stream);
215}
216
217li_object *li_class_type::create(li_object *params, li_environment *env)
218{
219  return new li_class(type, params, env);
220}
221
222
223// these load and save type information
224void li_class_type::save(i4_saver_class *fp, li_environment *env)
225{
226  fp->write_32(vars.size());
227  for (int i=0; i<vars.size(); i++)
228    li_save_object(fp,vars[i].sym, env);
229}
230
231
232void li_class_type::load_done()
233{
234  if (value_remap)
235  {
236    i4_free(value_remap);
237    value_remap=0;
238  }
239}
240
241void li_class_type::load(i4_loader_class *fp, li_type_number *type_remap,
242                         li_environment *env)
243{
244  old_tvars=fp->read_32();
245  if (old_tvars)
246  {
247    value_remap=(sw16 *)i4_malloc(sizeof(sw16) * old_tvars, "");
248    for (int j=0; j<old_tvars; j++)
249      value_remap[j]=-1;
250
251    for (int i=0; i<old_tvars; i++)
252    {
253      li_symbol *old_sym=li_symbol::get(li_load_object(fp, type_remap,env), env);
254      for (int j=0; j<vars.size(); j++)
255        if (old_sym==vars[j].sym)
256          value_remap[i]=j;
257    }
258  }
259}
260
261
262
263void li_class::save(i4_saver_class *fp, li_environment *env)
264{
265  li_class_type *ct=get_type();
266
267  int t_vars=ct->vars.size();
268  for (int i=0; i<t_vars; i++)
269  {
270    li_object *def=ct->vars[i].default_value;
271    li_object *v=value(i);
272
273    if (li_get_type(def->type())->equal(def, v))
274      li_save_object(fp, 0, env);
275    else
276      li_save_object(fp, value(i), env);
277  }
278}
279
280  // load & save type instance information
281void li_class_type::save_object(i4_saver_class *fp, li_object *o, li_environment *env)
282{
283  li_class::get(o,env)->save(fp, env);
284}
285
286void li_class::load(i4_loader_class *fp, li_type_number *type_remap, li_environment *env)
287{
288  li_class_type *ct=get_type();
289  int old_tvars=ct->old_tvars;
290  sw16 *value_remap=ct->value_remap;
291
292  for (int i=0; i<old_tvars; i++)
293  {
294    li_object *o=li_load_object(fp, type_remap, env);
295    int remap=value_remap[i];
296    if (remap!=-1)
297    {
298      li_object *def=ct->vars[remap].default_value;
299         
300      // if type has changed use default value     
301      if ( (def && o) && o->type()==def->type())
302        set_value(remap, o);
303    }
304  }
305}
306
307li_object *li_class_type::load_object(i4_loader_class *fp, li_type_number *type_remap,
308                                      li_environment *env)
309{
310  li_class *c=new li_class(type);
311  c->load(fp, type_remap, env);
312  return c;
313}
314
315
316//////////////////////////////////// li_class members /////////////////////////////////
317
318li_class::li_class(li_type_number class_type,
319                   li_object *params,
320                   li_environment *env)
321  : li_object(class_type)
322{
323  li_class_type *ct=get_type();
324  int t_vars=ct->vars.size();
325
326  values=(void **)i4_malloc(sizeof(void *) * t_vars, "");
327
328
329  int i;
330  for (i=0; i<t_vars; i++)
331    set_value(i, ct->vars[i].default_value);
332
333
334
335  i=0;
336  while (params)
337  {
338    li_object *val=li_eval(li_car(params,env));
339   
340
341    for (int j=0; j<t_vars; j++)
342      if (ct->vars[j].original_order==i)
343      {
344        set_value(j, val);
345        j=t_vars;
346      }
347
348    params=li_cdr(params,env);
349    i++;
350  }
351 
352
353}
354
355
356void li_class::print(i4_file_class *fp)
357{       
358  fp->write("#inst-",6);
359
360  li_class_type *c=get_type();
361
362  char *name=c->name();
363  fp->write(name,strlen(name));
364
365  fp->write_8('<');
366
367  for (int i=0; i<c->vars.size(); i++)
368  {
369    li_symbol *sym=c->vars[i].sym;
370
371    fp->write(" (",2);
372    li_get_type(LI_SYMBOL)->print(sym, fp);
373    fp->write_8(' ');
374
375    li_object *v=value(i);
376    li_get_type(v->type())->print(v, fp);
377
378    fp->write_8(')');
379  }
380
381  fp->write_8('>');
382
383}
384
385void li_class::free()
386{
387  i4_free(values);
388}
389
390
391
392
393int li_class::member_offset(char *sym) const
394{
395  return get_type()->get_var_offset(li_get_symbol(sym), 0);
396}
397
398int li_class::member_offset(li_symbol *sym) const
399{
400  return get_type()->get_var_offset(sym, 0);
401}
402
403
404int li_class::get_offset(li_class_member &c, li_type_number _type) const
405{
406  li_class_type *ct=get_type();
407
408  if (!c.sym)
409    c.sym=li_get_symbol(c.name);
410 
411  c.class_type=type();
412  c.offset=ct->get_var_offset(c.sym, 1);
413
414  if (c.offset==-1)
415    li_error(0, "class %s does not have a member %s", ct->name(), c.name);
416
417#ifdef LI_TYPE_CHECK
418  if (ct->vars[c.offset].default_value->type()!=_type)
419    li_error(0, "class member %O is wrong type (%s should be %s)",
420             c.sym,
421             li_get_type(_type)->name(),
422             li_get_type(ct->vars[c.offset].default_value->type())->name()); 
423#endif
424
425
426  return c.offset;
427}
428
429
430
431int li_class::get_offset(li_class_member &c) const
432{
433  li_class_type *ct=get_type();
434
435  if (!c.sym)
436    c.sym=li_get_symbol(c.name);
437 
438  c.class_type=type();
439  c.offset=ct->get_var_offset(c.sym, 0);
440
441  return c.offset;
442}
443
444
445
446#ifdef LI_TYPE_CHECK
447li_class *li_class::get(li_object *o, li_environment *env)
448{
449  check_type(o, ((li_class_type *)li_get_type(o->type()))->type, env);   
450  return ((li_class *)o);
451}
452#endif
453
454
455li_object *li_class::value(int member)
456{
457  switch (get_type()->vars[member].default_value->type())
458  {
459    case LI_INT : return new li_int(int_value(member)); break;
460    case LI_FLOAT : return new li_float(float_value(member)); break;
461    default : return object_value(member); break;
462  }
463}
464
465li_object *li_class::value(char *member_name)
466{
467  return value(member_offset(member_name));
468}
469
470
471void li_class::set_value(int member, li_object *value)
472{   
473  li_class_type *ct=get_type();
474  li_object *def_value=ct->vars[member].default_value;
475
476  int t=def_value->type();
477  switch (t)
478  {
479    case LI_INT : int_value(member) = li_int::get(value,0)->value(); break;
480    case LI_FLOAT : float_value(member) = li_float::get(value,0)->value(); break;
481    default : object_value(member)=value;
482  }
483}
484
485
486
487///////////////////////////////////// li_def_class ///////////////////////////////////////////
488
489li_object *li_def_class(li_object *fields, li_environment *env)
490{
491  li_symbol *sym=li_symbol::get(li_car(fields,env),env);  fields=li_cdr(fields,env);
492  li_object *derived=li_eval(li_car(fields,env), env); fields=li_cdr(fields,env);
493  li_class_type  *d=0;
494  int derived_type=0;
495 
496  if (derived!=li_nil)
497  {
498    derived_type=li_type::get(derived,env)->value();
499    if (derived_type)
500    {   
501      d=(li_class_type *)li_get_type(derived_type);
502      if (d->type!=derived_type)
503        li_error(env, "cannot derive a class from %O, only other classes", derived);
504    }
505    else li_error(env, "no such type %O", derived);
506  }
507
508  li_class_type *me=new li_class_type(sym, d);
509
510  li_object *c;
511  int t_vars=0;
512
513  // how many variables in the parent class
514  if (derived_type)
515    t_vars+=li_class_total_members(derived_type); 
516 
517  for (c=fields; c; c=li_cdr(c,env))      // count how many variables were added
518    t_vars++;
519
520  me->vars.resize(t_vars);
521
522  t_vars=0;
523
524  if (derived_type)
525  {
526    int t_from_derived_class=li_class_total_members(derived_type);
527    for (int i=0; i<t_from_derived_class; i++)
528    {
529      me->vars[t_vars].init();
530      me->vars[t_vars].original_order=t_vars;
531      li_symbol *s=li_class_get_symbol(derived_type, i);
532      me->vars[t_vars].sym=s;
533      me->vars[t_vars].default_value=li_class_get_default(derived_type, s);
534      me->vars[t_vars].property_list=li_class_get_property_list(derived_type, s);
535      t_vars++;
536    }
537  }
538   
539
540  for (c=fields; c; c=li_cdr(c,env))
541  {
542    li_object *var=li_car(c,env);
543    me->vars[t_vars].init();
544    me->vars[t_vars].original_order=t_vars;
545   
546   
547    me->vars[t_vars].sym=li_symbol::get(li_car(var,env),env);  var=li_cdr(var,env);
548   
549    if (var)
550    {
551      me->vars[t_vars].default_value=li_eval(li_car(var,env), env);  var=li_cdr(var,env);     
552
553      li_symbol *s=me->vars[t_vars].sym;
554      li_object *d=me->vars[t_vars].default_value;
555
556
557      if (var)
558        me->vars[t_vars].property_list=li_eval(li_car(var,env), env);
559    }
560
561    t_vars++;
562  }
563   
564  me->vars.sort(li_class_type::var_compare);
565  me->editor=li_class_editor;
566  me->type=li_add_type(me);
567
568  return new li_type(me->type);
569}
570
571li_object *li_class::set(char *member_name, li_object *value) // slow, but easy way to access data
572{
573  int off=member_offset(member_name);
574  if (off==-1)
575    li_error(0, "class %o does not have member %s", member_name);
576  set_value(off, value);
577  return value;
578}
579
580
581int li_class_type::var_compare(const var *a, const var *b)
582{
583  if (a->sym<b->sym)
584    return -1;
585  else if (a->sym>b->sym)
586    return 1;
587  else return 0;
588}
589
590
591int li_class_total_members(li_type_number type)
592{
593  return li_class_type::get(li_get_type(type),0)->vars.size();
594}
595
596li_symbol *li_class_get_symbol(li_type_number type, int member_number)
597{
598  li_class_type *ct=li_class_type::get(li_get_type(type),0);
599  return ct->vars[member_number].sym;
600}
601
602
603li_object *li_class_get_default(li_type_number type, li_symbol *sym)
604{
605  li_class_type *ct=li_class_type::get(li_get_type(type),0);
606  return ct->vars[ct->get_var_offset(sym, 1)].default_value;
607}
608
609li_object *li_class_get_property_list(li_type_number type, li_symbol *sym)
610{
611  li_class_type *ct=li_class_type::get(li_get_type(type),0);
612  return ct->vars[ct->get_var_offset(sym, 1)].property_list;
613}
614
615li_object *li_setm(li_object *o, li_environment *env)
616{
617  li_class *c=li_class::get(li_first(o,0),0);
618  li_symbol *member=li_symbol::get(li_second(o,0),0);
619  li_object *value=li_eval(li_third(o,0), env);
620  c->set_value(c->member_offset(member), value);
621  return value;
622}
623
624li_object *li_getm(li_object *o, li_environment *env)
625{
626  li_class *c=li_class::get(o,0);
627  return c->value(c->member_offset(li_symbol::get(li_first(o,0),0))); 
628}
629
630
631
632li_automatic_add_function(li_def_class, "def_class");
633li_automatic_add_function(li_setm, "setm");
634li_automatic_add_function(li_getm, "getm");
Note: See TracBrowser for help on using the repository browser.