Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/compiler/active.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 "Pliant active types"
doc
  text "A Pliant active type is one that provides it's own compiling function which will be called to compile an expression which value is of that type."
  text "A passive type will be compiled as itself: it's considered as a constant."
*/
 

static Void default_post_active(Arrow object, Int access, struct Expression *e) {}

FUNCTION Void call_active(Arrow object, Int access, struct Expression *e) {
  struct Type *t; struct Argument *arg;  TypeCompilePrototype compilefun;
  t=entry_type(object);
  compilefun=Type_get_generic_method_executable(t,G.generic_method_active_type);
  if(compilefun!=undefined_method) {
    compilefun(object,access,e);
    check(e->result==null || (e->access&(Access_read|Access_write))!=0);
  other
    arg=argument(entry_type(object),Argument_constant,object); entry_lock(arg);
    active_type_Argument(arg,Access_read|Access_constant,e);
    entry_unlock(arg);} 
  if(Expression_is_compiled(e) && !error_notified())
    (*G.post_active_hook)(object,access,e);
}

static Void active_type_Ident(Arrow object,Int access,struct Expression *e) {
  struct Str *ident; struct Module *m;
  Arrow *c; Int definition;
  struct Expression *best; Address *selecteds; Int nb_selected;
  Int *best_cast_levels; Int best_definition;
  Int i,j,k; struct Expression *ei; Bool better,worse,clear,use;
  struct Function *f;
  Char buffer[16]; struct Str msg,temp,temp2;
  struct Str s;
  check(e->result==null);
  check(entry_type(object)==G.type_Ident);
  ident=(struct Str *)object; m=e->module;
  best=(struct Expression *)entry_new(G.type_Expression); entry_lock(best);
  best_cast_levels=(Int *)memory_allocate(e->arguments.nb*sizeof(Int),e);
  for(i=0; i<e->arguments.nb; i++)
    best_cast_levels[i]=int_max;
  selecteds=null; nb_selected=0;
  for(c=Module_first(m,ident); c!=G.null_constant; c=Module_next(m,ident,c)) {
    Expression_compile_step4(e,*c,Access_constant);
    if(error_notified()) {
      entry_unlock(best);
      memory_free(best_cast_levels);
      memory_free(selecteds);
      return; }
    if(!Expression_is_compiled(e)) {
      Expression_uncompile(e);
      for(i=0; i<e->arguments.nb; i++)
        Expression_uncast(EARG(e,i));
      continue; }
    definition=e->access&(Definition_weak|Definition_strong|Definition_always);
    e->access-=definition;
    better=worse=false;
    for(i=0; i<e->arguments.nb; i++) {
      ei=EARG(e,i);
      if(ei->cast_level<best_cast_levels[i])
        best_cast_levels[i]=ei->cast_level,better=true;
      eif(ei->cast_level>best_cast_levels[i])
        worse=true; }
    clear=use=false;
    if((better && !worse) || nb_selected==0) 
      clear=true;
    eif(worse && !better)
      ;
    eif(definition==Definition_strong+Definition_always && best_definition!=Definition_strong+Definition_always)
      clear=true;
    eif(best_definition&Definition_strong)
      ;
    eif(definition==Definition_weak+Definition_always && best_definition!=Definition_weak+Definition_always)
      ;
    eif(best_definition&Definition_weak)
      clear=true;
    else
      use=true;
    if(clear) {
      selecteds=memory_resize(selecteds,sizeof(Address),e); selecteds[0]=c; nb_selected=1;
      Expression_uncompile(best);
      Expression_copy(e,best);
      best_definition=definition;
      Arrow_set((Arrow *)&best->op,*c);
    orif(use)
      for(k=0; k<nb_selected; k++)
        if(*(Arrow *)selecteds[k]==*c)
          goto escape;
      selecteds=memory_resize(selecteds,(nb_selected+1)*sizeof(Address),e); selecteds[nb_selected++]=c;
      escape:; }
    Expression_uncompile(e);
    for(i=0; i<e->arguments.nb; i++)
      Expression_uncast(EARG(e,i)); }
  if(nb_selected==1) {
    Expression_copy(best,e);
  orif(nb_selected>0)
    Str_build(&msg);
    Str_addz("ambiguous usage of ",&msg);
    Str_add(ident,&msg);
    for(j=0; j<nb_selected; j++) {
      c=selecteds[j];
      Expression_compile_step4(e,*c,Access_constant);
      Str_addz("\n  could be ",&msg);
      if(entry_type(*c)==G.type_Function) {
        f=(struct Function *)*c;
        Str_addz("function ",&msg);
        Str_add(&f->name,&msg);
        for(i=0; i<f->nb_arg; i++) {
          Str_addz(" ",&msg);
          Str_add(&f->arguments[i].type->name,&msg); 
          ei=EARG(e,i);
          if(ei->uncasted_result!=null) {
            Str_addz(":",&msg);
            Str_add(Str_map_area(&temp2,buffer,Int_str2(ei->cast_level,10,buffer)),&msg); } }
        if(f->nb_argres>f->nb_arg) {
          Str_addz(" -> ",&msg);
          Str_add(&f->arguments[f->nb_arg].type->name,&msg); }
        Str_addz(" (",&msg);
        Str_build(&s);
        ListingPosition_get(&f->position,&s);
        Str_add(&s,&msg);
        Str_destroy(&s);
        Str_addz(")",&msg);
      orif(entry_type(*c)==G.type_Meta) 
        f=(struct Function *)*c;
        Str_addz("meta ",&msg);
        Str_add(&f->name,&msg);
        Str_addz(" (",&msg);
        Str_build(&s);
        ListingPosition_get(&f->position,&s);
        Str_add(&s,&msg);
        Str_destroy(&s);
        Str_addz(")",&msg);
      other
        Str_addz("an object with type ",&msg);
        Str_add(&entry_type(*c)->name,&msg);
        Str_addz(" defined in ",&msg);
        Str_add(struct_from_field(DictNode2,object,c)->module->name,&msg); } }
    error_notifyn(error_id_compile,S,&msg,END);
    Str_destroy(&msg); }
  entry_unlock(best);
  memory_free(best_cast_levels);
  memory_free(selecteds); }


static Void active_type_Function(Arrow object,Int access,struct Expression *e) {
  struct Function *f; Address old; struct Str temp;
  struct Function *f; Address old;
  Int i; struct FunctionPrototype *fi; struct Expression *ei;
  struct Instruction *instr; struct Argument *arg; Int a;
  check(entry_type(object)==G.type_Function);
  f=(struct Function *)object;
  if(f->flags&Function_flag_hidden) return;
  // begin of pom patch
  if(f->nb_arg==0 && f->nb_arg!=e->arguments.nb) {
    // try to compile e with no arguments, then the result with the arguments
    struct Expression *node, *args;
    node=entry_new(G.type_Expression); entry_lock(node);
    Arrow_copy((Arrow *)&e->module,(Arrow *)&node->module);
    ListingPosition_copy(&e->position,&node->position);
    Arrow_set(&node->value,e->value);
    active_type_Function(object,access,node);
    call_active(object,access,node);
    if(Expression_is_compiled(node) && !error_notified()) {
      args=entry_new(G.type_Expression); entry_lock(args);
      Expression_copy(e,args);
      Expression_compile_step4(args,node->result,node->access);
      if(Expression_is_compiled(args) && !error_notified()) {
        Expression_suckup(e,node);
        Expression_suckup(e,args);
Expression_copy_properties(args,e);
Dictionary_copy(&node->properties, &e->properties);
        Expression_set_result(e,args->result,args->access|(Definition_weak+Definition_always)); }
      entry_unlock(args); }
    entry_unlock(node);
    return; }
  // end of pom patch
  if(f->nb_arg!=e->arguments.nb) return;
  if(f->extra_module!=null)
    old=Relation_define(&e->module->visibles,f->extra_module,null,G.true_constant);
  for(i=0; i<f->nb_arg; i++) {
    fi=f->arguments+i,ei=EARG(e,i);
    if(!Expression_cast(ei,fi->type)) goto escape;
    if((fi->access&Access_write) && !(ei->access&Access_write)) goto escape;
    if((fi->access&Access_object) && !(ei->access&Access_object)) goto escape; }
  Dictionary_insert(&e->properties,Str_map_string(&temp,"active"),true,f);
  instr=(struct Instruction *)entry_new(G.type_Instruction);
  Instruction_set_function(instr,f);
  for(i=0; i<f->nb_arg; i++) {
    fi=f->arguments+i,ei=EARG(e,i);
    Instruction_set_argument(instr,i,ei->result);
    Expression_suckup(e,ei); }
  if(f->nb_arg<f->nb_argres) {
    if(f->arguments[f->nb_arg].access&Access_mapped) {
      arg=argument(f->arguments[f->nb_arg].type,Argument_indirect,argument(G.type_Address,Argument_local),0);
    other
      arg=argument(f->arguments[f->nb_arg].type,Argument_local); }
    Instruction_set_argument(instr,f->nb_arg,arg);
    a=f->arguments[f->nb_arg].access;
    Expression_set_result(e,arg,
      (a&Access_result_read ? Access_read : 0)|
      (a&Access_result_write ? Access_write : 0)|
      (a&Access_object ? Access_object : 0)|
      (a&Access_result_consistent ? EARG(e,0)->access&(Access_read|Access_write) : 0) );
  other
    Expression_set_void_result(e); }
  e->access|=f->definition;
  Expression_add(e,instr);
  escape:
  if(f->extra_module!=null)
    Relation_define(&e->module->visibles,f->extra_module,null,old); }


static Void active_type_Meta(Arrow object,Int access,struct Expression *e) {
  struct Function *f; Address old;struct Str temp;
  struct Function *f; Address old;
  check(entry_type(object)==G.type_Meta);
  f=(struct Function *)object;
  if(f->extra_module!=null)
    old=Relation_define(&e->module->visibles,f->extra_module,null,G.true_constant);
  ((FunctionMacroPrototype)f->exe)(e);
  if(f->extra_module!=null)
    Relation_define(&e->module->visibles,f->extra_module,null,old);
  if(Expression_is_compiled(e)) {
    Dictionary_insert(&e->properties,Str_map_string(&temp,"active"),true,f);
    e->access|=f->definition;
  // begin of pom patch
  orif(e->arguments.nb!=0)
    // try to compile e with no arguments, then the result with the arguments
    struct Expression *node, *args;
    node=entry_new(G.type_Expression); entry_lock(node);
    Arrow_copy((Arrow *)&e->module,(Arrow *)&node->module);
    ListingPosition_copy(&e->position,&node->position);
    Arrow_set(&node->value,e->value);
    active_type_Meta(object,access,node);
    call_active(object,access,node);
    if(Expression_is_compiled(node) && !error_notified()) {
      args=entry_new(G.type_Expression); entry_lock(args);
      Expression_copy(e,args);
      Expression_compile_step4(args,node->result,node->access);
      if(Expression_is_compiled(args) && !error_notified()) {
        Expression_suckup(e,node);
        Expression_suckup(e,args);
Expression_copy_properties(args,e);
Dictionary_copy(&node->properties, &e->properties);
        Expression_set_result(e,args->result,args->access|(Definition_weak+Definition_always)); }
      entry_unlock(args); }
    entry_unlock(node); } }
  // end of pom patch


static Void active_type_Argument(Arrow object,Int access,struct Expression *e) {
  struct Argument *arg; struct Expression *e0;
  struct Expression *expr,*sub; Int i; Arrow id;
  struct Type *t;
  struct Argument2 *arg2;
  check(entry_type(object)==G.type_Argument);
  arg=(struct Argument *)object;
  if(e->arguments.nb==0) {
    Expression_set_result(e,arg,access);
  other
    e0=EARG(e,0);
    // try first argument as method argument
    if(e0->arguments.nb==0 && entry_type(e0->value)==G.type_Ident) {
      expr=entry_new(G.type_Expression); entry_lock(expr);
      Arrow_copy((Arrow *)&e0->module,(Arrow *)&expr->module);
      ListingPosition_copy(&e0->position,&expr->position);
      Array_resize(&expr->arguments,e->arguments.nb);
      sub=(struct Expression *)entry_new(G.type_Expression);
      Arrow_copy((Arrow *)&e->module,(Arrow *)&sub->module);
      ListingPosition_copy(&e->position,&sub->position);
      arg2=(struct Argument2 *)entry_new(G.type_Argument2);
      Arrow_set((Arrow *)&arg2->argument,arg);
      arg2->access=access;
      Arrow_set(&sub->value,arg2);
      Array_set_index(&expr->arguments,0,sub);
      for(i=1; i<e->arguments.nb; i++)
        Array_set_index(&expr->arguments,i,Array_get_index(&e->arguments,i));
      id=(struct Ident *)entry_new(G.type_Ident); entry_lock(id);
      Str_concat((struct Str *)id,Z,". ",S,e0->value,END);
      Expression_compile_step4(expr,id,Access_constant);
      entry_unlock(id);
      if(!error_notified() && Expression_is_compiled(expr)) {
        Dictionary_copy(&expr->properties, &e0->properties);
Dictionary_copy(&expr->properties, &e0->properties);
        Expression_suckup(e,expr);
        Expression_set_result(e,expr->result,expr->access); }
      Expression_suckup_error(e,expr);
      Expression_suckup_error(e,sub);
      entry_unlock(expr); }
    // try no argument as method argument
    if(!Expression_is_compiled(e) && !error_notified()) {
      expr=entry_new(G.type_Expression); entry_lock(expr);
      Arrow_copy((Arrow *)&e->module,(Arrow *)&expr->module);
      ListingPosition_copy(&e->position,&expr->position);
      Array_resize(&expr->arguments,e->arguments.nb+1);
      sub=(struct Expression *)entry_new(G.type_Expression);
      Arrow_copy((Arrow *)&e->module,(Arrow *)&sub->module);
      ListingPosition_copy(&e->position,&sub->position);
      arg2=(struct Argument2 *)entry_new(G.type_Argument2);
      Arrow_set((Arrow *)&arg2->argument,arg);
      arg2->access=access;
      Arrow_set(&sub->value,arg2);
      Array_set_index(&expr->arguments,0,sub);
      for(i=0; i<e->arguments.nb; i++)
        Array_set_index(&expr->arguments,i+1,Array_get_index(&e->arguments,i));
      id=entry(G.type_Ident,"",END); entry_lock(id);
      Expression_compile_step4(expr,id,Access_constant);
      entry_unlock(id);
      if(!error_notified() && Expression_is_compiled(expr)) {
        Expression_suckup(e,expr);
        Expression_set_result(e,expr->result,expr->access); }
      Expression_suckup_error(e,expr);
      Expression_suckup_error(e,sub);
      entry_unlock(expr); }
    /*
    // try to apply on the real data type
    if(!Expression_is_compiled(e) && !error_notified()) {
      sub=(struct Expression *)entry_new(G.type_Expression); entry_lock(sub);
      Arrow_copy((Arrow *)&e->module,(Arrow *)&sub->module); Str_copy(&e->position,&sub->position);
      Expression_set_result(sub,arg,access);
      t=Type_real_data_type(arg->type);
      if(t!=arg->type && Expression_cast(sub,t)) {
        expr=(struct Expression *)entry_new(G.type_Expression); entry_lock(expr);
        Expression_copy(e,expr);
        compile_Argument(sub->result,sub->access,expr);
        if(Expression_is_compiled(expr)) {
          Expression_suckup(e,sub);
          Expression_suckup(e,expr);
          Expression_set_result(e,expr->result,expr->access); }
        entry_unlock(expr); }
      entry_unlock(sub); } */ } }

static Void active_type_Argument2(Arrow object,Int access,struct Expression *e) {
  struct Argument2 *arg2;
  arg2=(struct Argument2 *)object;
  Expression_compile_step4(e,arg2->argument,arg2->access); }


static Void active_type_LocalVariable(Arrow object,Int access,struct Expression *e) {
  struct LocalVariable *l; struct Str temp;
  struct LocalVariable *l;
  check(entry_type(object)==G.type_LocalVariable);
  l=(struct LocalVariable *)object;
  if(l->function!=current_function())
    return;
  if(l->body->type!=null) {
    Expression_compile_step4(e,l->body,l->access);
    if(Expression_is_compiled(e)) {
    if(Expression_is_compiled(e))
      e->access|=Definition_strong;
      Dictionary_insert(&e->properties,Str_map_string(&temp,"active"),true,object); }
  other
    error_notifyn(error_id_compile,Z,"Type of argument ",S,&l->name,Z," is not defined",END); } }


static Void active_type_GlobalVariable(Arrow object,Int access,struct Expression *e) {
  struct GlobalVariable *gv;
  struct Argument *a,*a2;
  Arrow *c; struct Str temp;
  check(entry_type(object)==G.type_GlobalVariable);
  Dictionary_insert(&e->properties,Str_map_string(&temp,"active"),true,object);
  gv=(struct GlobalVariable *)object;
  a=argument(G.type_Address,Argument_constant,entry(G.type_Address,gv->variable,END));
  List_append(&a->requires,gv->variable);
  a2=argument(entry_type(gv->variable),Argument_indirect,a,0); entry_lock(a2);
  Expression_compile_step4(e,a2,gv->access);
  entry_unlock(a2);
  c=Module_first(e->module,Str_map_string(&temp,"pliant function"));
  if(c!=G.null_constant) {
    check(entry_type(*c)==G.type_Function || entry_type(*c)==G.type_Meta);
    ((struct Function *)*c)->flags|=Function_flag_has_side_effects; } }