Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/compiler/type/type.c
Key:
    Removed line
    Added line
// Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
//
// This program is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License version 2
// as published by the Free Software Foundation.
// 
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
// 
// You should have received a copy of the GNU General Public License
// version 2 along with this program; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

/*
abstract
  text "'Type' data type"
*/
 

static Void TypeField_build(struct TypeField *f) {
  Arrow_build((Arrow *)&f->type);
  Arrow_build(&f->initial_value);
  Str_build(&f->name);
  Dictionary_build(&f->properties); }


static Void TypeField_destroy(struct TypeField *f) {
  Arrow_destroy((Arrow *)&f->type);
  Arrow_destroy(&f->initial_value);
  Str_destroy(&f->name);
  Dictionary_destroy(&f->properties); }


/*****************************************************************************/


static Void undefined_method() {
  error_notifyn(error_id_missing,Z,"Attempted to call an undefined generic method",END); }


FUNCTION Void Type_build(struct Type *type) {
  Int i;
  _check_( type->signature=Type_signature; )
  type->flags=Type_flag_scalar;
  type->size=0;
  type->fields=null,type->nb_field=0;
  Str_build(&type->name);
  ListingPosition_build(&type->position);
  Dictionary_build(&type->properties);
  List_build(&type->maybe);
  type->generic_level=1;
  for(i=0; i<G.generic_nb_indices; i++) {
    type->generic_methods[i].exe=undefined_method;
    Arrow_build((Arrow *)&type->generic_methods[i].function); }
  _check_( type->objects_counter=0; ) }


FUNCTION Void Type_destroy(struct Type *type) {
  Int i; Arrow *r;
  if(G.execution_phase==phase_run)
    for(r=List_first(G.type_destroy_hooks); r!=G.null_constant; r=List_next(r)) {
      check(entry_type(*r)==G.type_Function);
      ((TypeDestroyHookPrototype)((struct Function *)*r)->exe)(type); }
  _check_( type->signature=~Type_signature; )
  for(i=0; i<type->nb_field; i++)
    TypeField_destroy(type->fields+i);
  memory_free(type->fields);
  Str_destroy(&type->name);
  ListingPosition_destroy(&type->position);
  Dictionary_destroy(&type->properties);
  List_destroy(&type->maybe);
  for(i=0; i<G.generic_nb_indices; i++)
    Arrow_destroy((Arrow *)&type->generic_methods[i].function); }


#ifdef _CHECK_
  INLINE Err Type_is_corrupted(struct Type *type) {
    return (type==null || type->signature!=Type_signature); }
#endif


FUNCTION Void Type_define_field(struct Type *type,struct Type *ftype,struct Str *fname,Address initial_value) {
  Int index; struct TypeField *field;
  check(!Type_is_corrupted(type));
  check(!Type_is_corrupted(ftype));
  if(memory_size(type->fields)<(type->nb_field+1)*sizeof(struct TypeField))
    type->fields=(struct TypeField *)memory_resize(type->fields,maximum(2*type->nb_field,64)*sizeof(struct TypeField),null);
  index=type->nb_field++; field=type->fields+index;
  TypeField_build(field);
  Arrow_set((Arrow *)&field->type,ftype);
  Str_copy(fname,&field->name);
  Arrow_set(&field->initial_value,initial_value);
  /**/
  if(!(field->type->flags&Type_flag_scalar) || initial_value!=null)
    type->flags&=~Type_flag_scalar;
  if(index==0 && (field->type->flags&Type_flag_atomic) && initial_value==null)
    type->flags|=Type_flag_atomic;
  else
    type->flags&=~Type_flag_atomic;
  if(index!=0) {
    field->offset=field[-1].offset+field[-1].type->size;
  other
    field->offset=0; }
  type->size=field->offset+field->type->size; }



FUNCTION struct TypeField *Type_map_field(struct Type *t,Int number) {
  check(number>=0 && number<t->nb_field);
  return t->fields+number; }


FUNCTION Void Type_terminate_fields(struct Type *type) {
  struct TypeField *f; Arrow *r;
  f=(struct TypeField *)memory_allocate(type->nb_field*sizeof(struct TypeField),type);
  memory_copy(type->fields,f,type->nb_field*sizeof(struct TypeField));
  memory_free(type->fields);
  type->fields=f;
  if(G.execution_phase==phase_run)
    for(r=List_first(G.type_build_hooks); r!=G.null_constant; r=List_next(r)) {
      check(entry_type(*r)==G.type_Function);
      ((TypeCreateHookPrototype)((struct Function *)*r)->exe)(type); } }


FUNCTION Void Type_may_be(struct Type *generic_type,struct Type *type) {
  Arrow *c; struct Type *t; Int i;
  for(c=List_first(&generic_type->maybe); c!=G.null_constant; c=List_next(c)) {
    t=(struct Type *)*c;
    if(t==type) return; }
  List_append(&generic_type->maybe,type);
  if(generic_type->flags&Type_flag_grow)
    generic_type->size=maximum(generic_type->size,type->size);
  generic_type->flags&=~(Type_flag_atomic|Type_flag_scalar); 
  for(i=0; i<G.generic_nb_indices; i++) 
    if(Type_get_generic_method(type,i)==null && Type_get_generic_method(generic_type,i)!=null)
      Type_set_generic_method(type,i,Type_get_generic_method(generic_type,i)); }
  /*
  for(c=List_first(&type->maybe); c!=G.null_constant; c=List_next(c)) {
    t=(struct Type *)*c;
    Type_may_be(generic_type,t); }
  */


static Void Type_recurse_may_be2(struct Type *generic,struct Type *type) {
  Arrow *r,*r2; struct Type *t,*t2;
  for(r=List_first(&type->maybe); r!=G.null_constant; r=List_next(r)) {
    t=(struct Type *)*r;
    for(r2=List_first(&generic->maybe); r2!=G.null_constant; r2=List_next(r2)) {
      t2=(struct Type *)*r2;
      if(t2==t)
        goto already; }
    List_append(&generic->maybe,t);
    already:
    Type_recurse_may_be2(generic,t); } }

FUNCTION Void Type_recurse_may_be(struct Type *type) {
  Arrow *r;
  for(r=List_first(&type->maybe); r!=G.null_constant; r=List_next(r))
    Type_recurse_may_be2(type,(struct Type *)*r); }


/*****************************************************************************/


FUNCTION Void Type_build_instance(struct Type *type,Address instance) {
  Int flags;
  TypeCreatePrototype build;
  Int i; struct TypeField *f;
  flags=type->flags;
  if(flags&Type_flag_scalar)
    return;
  if(flags&Type_flag_count)
    entry_lock(type);
  if(!(flags&Type_flag_direct_build))
    for(i=0; i<type->nb_field; i++) {
      f=type->fields+i;
      Type_build_instance(f->type,address_translate(instance,f->offset));
      if(f->initial_value!=null)
        Type_copy_instance(f->type,f->initial_value,address_translate(instance,f->offset)); }
  build=(TypeCreatePrototype)Type_get_generic_method_executable(type,G.generic_method_build);
  if(build!=undefined_method)
    build(instance); }


#ifdef _CHECK_STACK_
  Int destroy_level;
#endif

FUNCTION Void Type_destroy_instance(struct Type *type,Address instance) {
  Int flags;
  TypeDestroyPrototype destroy;
  Int i; struct TypeField *f;
  flags=type->flags;
  if(flags&Type_flag_scalar)
    return;
  #ifdef _CHECK_STACK_
    if(++destroy_level>=1000)
      consolen(Z,"Recursive destroy ",S,&type->name,EOL);
  #endif
  destroy=(TypeDestroyPrototype)Type_get_generic_method_executable(type,G.generic_method_destroy);
  if(destroy!=undefined_method)
    destroy(instance);
  if(!(flags&Type_flag_direct_destroy))
    for(i=0; i<type->nb_field; i++) {
      f=type->fields+i;
      Type_destroy_instance(f->type,address_translate(instance,f->offset)); } 
  if(flags&Type_flag_count)
    entry_unlock(type); }
    entry_unlock(type);
  #ifdef _CHECK_STACK_
    destroy_level--;
  #endif
  }


FUNCTION Void Type_copy_instance(struct Type *type,Address src,Address dest) {
  TypeCopyPrototype copy;
  Int i; struct TypeField *f;
  #ifdef _CHECK_
    if(type->flags&Type_flag_do_not_copy) {
      error_notifyn(error_id_unexpected,Z,"Attempted to copy an ",S,&type->name,END);
      return; }
  #endif
  if(type->flags&Type_flag_scalar) {
    memory_copy(src,dest,type->size);
    return; }
  copy=(TypeCopyPrototype)Type_get_generic_method_executable(type,G.generic_method_copy);
  if(copy!=undefined_method)
    copy(src,dest);
  else
    for(i=0; i<type->nb_field; i++) {
      f=type->fields+i;
      Type_copy_instance(f->type,address_translate(src,f->offset),address_translate(dest,f->offset)); } }


FUNCTION struct Type *Type_real_data_type(struct Type *t) {
  struct Type *t2;
  while( (t2=unpointerto(t)) !=null )
    t=t2;
  return t; }


/*****************************************************************************/

#include <stdarg.h>


FUNCTION struct Type *C_type0(Char *name,struct Module *module,Int size,Int flags,Address build,Address destroy,Address copy) {
  struct Type *t; struct Function *f;
  t=(struct Type *)entry_new1(G.type_Type,sizeof(struct EntryHeader)+sizeof(struct Type)+(G.generic_nb_indices-1)*sizeof(struct TypeGenericalMethod),(Void (*)(Address obj))Type_build);
  string_Str(name,&t->name);
  t->size=size;
  t->flags=flags|Type_flag_direct_build|Type_flag_direct_destroy|Type_flag_direct_copy;
  if(build!=null)
    Type_set_generic_method(t,G.generic_method_build,C_function("build",module,build,Function_flag_hidden, t,Aw, END));
  if(destroy!=null)
    Type_set_generic_method(t,G.generic_method_destroy,C_function("destroy",module,destroy,Function_flag_hidden, t,Aw, END));
  if(copy!=null)
    Type_set_generic_method(t,G.generic_method_copy,C_function("copy",module,copy,Function_flag_copy|Function_flag_hidden, t,Ar, t,Aw, END));
  Dictionary_insert2(G.general_dictionary,&t->name,true,t,module);
  if(!(flags&Type_flag_non_universal))
    Type_may_be(G.type_Universal,t);
  return t; }


FUNCTION struct Type *C_type(Char *name,struct Module *module,Int size, ...) {
  struct Type *type;
  va_list arguments; Char *n; struct Type *t; struct Str temp,temp2;
  Int i;
  type=(struct Type *)entry_new(G.type_Type);
  string_Str(name,&type->name);
  va_start(arguments,size);
  for(;;) {
    n=va_arg(arguments,Char *); if(n==END) break;
    t=va_arg(arguments,struct Type *);
    Type_define_field(type,t,Str_map_string(&temp,n),null); }
  va_end(arguments);
  Type_terminate_fields(type);
  if(size!=int_bad && size!=type->size)
    error_notify_fatalz(error_id_mismatch,"Type size is wrong");
  Dictionary_insert2(G.general_dictionary,&type->name,true,type,module);
  Type_may_be(G.type_Universal,type);
  va_start(arguments,size);
  for(i=0; ; i++) {
    n=va_arg(arguments,Char *); if(n==END) break;
    t=va_arg(arguments,struct Type *);
    C_field(type,n,module,t,type->fields[i].offset,AwmRW); }
  va_end(arguments);
  return type; }


FUNCTION struct Function *C_field(struct Type *type,Char *fieldname,struct Module *module,struct Type *fieldtype,Int fieldoffset,Int access) {
  struct Function *f; struct Argument *object,*field,*offset;
  struct Str fullname;
  Str_build(&fullname); Str_concat(&fullname,Z,". ",Z,fieldname,EOS);
  f=C_function(fullname.chars,module,null,Function_flag_inline_instructions, type,Ar, fieldtype,access, END);
  Str_destroy(&fullname);
  object=argument(type,Argument_undefined);
  field=argument(fieldtype,Argument_undefined);
  offset=argument(G.type_Int,Argument_constant,entry(G.type_Int,fieldoffset,END));
  Arrow_set((Arrow *)&f->arguments[0].inline_argument,object);
  Arrow_set((Arrow *)&f->arguments[1].inline_argument,field);
  List_append(&f->inline_instructions,instruction(G.function_translate_universal,object,offset,field,END));
  return f; }