Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/basic/extend.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
  list
    item
      link "modules related functions" "extend.c" section "module"
    item
      link "functions related functions" "extend.c" section "function"
    item
      link "types related functions" "extend.c" section "type"
*/
 

FUNCTION struct Function *current_function() {
  struct Str temp; Arrow *c;
  c=Dictionary_first(G.general_dictionary,Str_map_string(&temp,"pliant function"));
  check(entry_type(*c)==G.type_Function || entry_type(*c)==G.type_Meta);
  return (struct Function *)*c; }


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


/*
doc
  ['doc' and 'abstract' functions are routed here in order to simply drop the provided bloc.]
*/

static Void comment_meta(struct Expression *e) {
  if(e->arguments.nb==1)
    Expression_set_void_result(e); }


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

/*
doc
  section "module"
  ['module' and 'submodule' functions]
*/

static Void module_meta2(struct Expression *e,Int flags) {
  struct Str *name; Int i; struct Module *module;
  for(i=0; i<e->arguments.nb; i++)
    if(!Expression_constant(EARG(e,i),G.type_Str)) return;
  for(i=0; i<e->arguments.nb; i++) {
    name=(struct Str *)Expression_constant(EARG(e,i),G.type_Str);
    module=load_module(name,G.safe_module,flags,e->module);
    if(module==null)
      error_notifyn(error_id_compile,Z,"Failed to load module ",S,name,END); }
  Expression_set_void_result(e); }

static Void module_meta(struct Expression *e) {
  module_meta2(e,0); }

static Void submodule_meta(struct Expression *e) {
  module_meta2(e,Module_flag_submodule); }


/*
doc
  ['scope' function]
*/

static Void scope_meta(struct Expression *e) {
  Int i;
  for(i=0; i<e->arguments.nb; i++) {
    if(!Expression_cast(EARG(e,i),G.type_Str))
      return;
    Expression_suckup(e,EARG(e,i));
    Expression_add(e,instruction(G.function_module_add_scope,argument(G.type_Module,Argument_constant,e->module),EARG(e,i)->result,END)); }
  Expression_set_void_result(e); } 


/*
doc
  ['ring_module' function]
*/

static Void ring_meta(struct Expression *e) {
  struct Module *m;
  if(e->arguments.nb!=0)
    return;
  m=e->module; if(m->external!=null) m=m->external;
  Expression_add(e,instruction(G.function_module_set_ring,argument(G.type_Module,Argument_constant,m),END));
  Expression_set_void_result(e); }


/*
doc
  ['public' and 'private' functions]
*/

static Void public_meta(struct Expression *e) {
  struct Module *m; Int old;
  m=e->module;
  if(e->arguments.nb==0) {
    if(m->external!=null)
      m->flags|=Module_flag_public;
    Expression_set_void_result(e); 
  orif(e->arguments.nb==1)
    old=m->flags&Module_flag_public;
    if(m->external!=null)
      m->flags|=Module_flag_public;
    Expression_compile(EARG(e,0));
    m->flags=(m->flags&~Module_flag_public)|old;
    Expression_suckup(e,EARG(e,0));
    Expression_set_void_result(e); } }

static Void private_meta(struct Expression *e) {
  if(e->arguments.nb!=0) return;
  e->module->flags&=~Module_flag_public;
  Expression_set_void_result(e); }


/*
doc
  ['export' function]
*/

static Void export_meta(struct Expression *e) {
  struct Module *internals,*externals;
  Int i; struct Str *name;
  Bool some;
  Arrow *c; struct DictNode2 *node;
  struct Function *f; struct GlobalVariable *gv;
  internals=e->module;
  externals=internals->external; if(externals==null) return;
  for(i=0; i<e->arguments.nb; i++)
    if(Expression_pure_ident(EARG(e,i))==null) return;
  for(i=0; i<e->arguments.nb; i++) {
    name=(struct Str *)Expression_pure_ident(EARG(e,i));
    some=false;
    for(c=Dictionary_first(G.general_dictionary,name); c!=G.null_constant; c=Dictionary_next(G.general_dictionary,name,c)) {
      node=struct_from_field(DictNode2,object,c);
      if(node->module==internals || node->module==externals)
        node->module=externals,some=true; }
    if(!some)
      error_notifyn(error_id_compile,S,name,Z," is not defined,",END); }
  Expression_set_void_result(e); }


/*
doc
  ['alias' function]
*/

static Void alias_meta(struct Expression *e) {
  struct Str *alias,*name; struct Module *from_module,*to_module; struct Module **what;
  Int i; struct Str temp;
  Bool some; Arrow *c;
  struct Function *f; struct GlobalVariable *gv;
  struct DictNode2 *node;
  from_module=Module_actual(e->module),to_module=from_module;
  if(e->arguments.nb<2 || e->arguments.nb>6 || e->arguments.nb%2!=0)
    return;
  for(i=2; i<e->arguments.nb; i+=2) {
    name=(struct Str *)Expression_pure_ident(EARG(e,i));
    if(name==null) return;
    if(compare_str(name,Str_map_string(&temp,"from"))==compare_equal)
      what=&from_module;
    eif(compare_str(name,Str_map_string(&temp,"in"))==compare_equal)
      what=&to_module;
    else
      return;
    name=(struct Str *)Expression_constant(EARG(e,i+1),G.type_Str); if(name==null) return;
    *what=load_module(name,G.safe_module,0,null);
    if(*what==null && !error_notified()) {
      error_notifyn(error_id_compile,Z,"Failed to load module ",S,name,END); 
      return; } }
  alias=(struct Str *)Expression_pure_ident(EARG(e,0)); if(alias==null) return;
  name=(struct Str *)Expression_pure_ident(EARG(e,1)); if(name==null) return;
  some=false;
  for(c=Module_first(from_module,name); c!=G.null_constant; c=Module_next(from_module,name,c)) {
    node=struct_from_field(DictNode2,object,c);
    if (node->module==from_module || node->module==from_module->external)
      Expression_define(e,alias,*c,to_module),some=true; }
  if(!some)
    error_notifyn(error_id_compile,S,name,Z," is not defined",END);
  Expression_set_void_result(e); }


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

/*
doc
  section "function"
  ['arg' 'arg_w' 'arg_rw' ... functions]
*/

static Void arg_type_meta(struct Expression *e,Int access) {
  struct Type *t; struct Function *fun; struct Array *arguments;
  Int i,index; struct Str *name;
  Arrow *c;
  struct Str err;
  struct LocalVariable *farg; Int a; struct Type *tt;
  struct Str temp; Char buffer[16];
  if(e->arguments.nb<2) return;
  t=Expression_constant(EARG(e,0),G.type_Type); if(t==null) return;
  for(i=1; i<e->arguments.nb; i++)
    if(Expression_pure_ident(EARG(e,i))==null) return;
  fun=current_function();
  c=Dictionary_first(G.general_dictionary,Str_map_string(&temp,"pliant arguments"));
  check(entry_type(*c)==G.type_Array);
  arguments=(struct Array *)*c;
  for(i=1; i<e->arguments.nb; i++) {
    name=(struct Str *)Expression_pure_ident(EARG(e,i));
    c=Module_first(e->module,name);
    if(c==G.null_constant || entry_type(*c)!=G.type_LocalVariable) {
      error_notifyn(error_id_compile,S,name,Z," is not an argument",END);
      return; }
    farg=(struct LocalVariable *)*c;
    for(index=0; index<arguments->nb; index++)
      if(Array_get_index(arguments,index)==farg->body)
        break;
    if(index==arguments->nb) {
      error_notifyn(error_id_compile,S,name,Z," is not an argument",END);
      return; }
    a=(access&Access_auto ? (index<fun->nb_arg ? Ar : AwR)|(access&Access_object) : access);
    tt=(a&Access_mapped ? pointerto(t) : t);
    if(farg->body->type!=null && (farg->body->type!=tt || farg->access!=a)) {
      error_notifyn(error_id_compile,Z,"Type of ",S,name,Z," is already defined",END);
      return; }
    Argument_locate(farg->body,tt,Argument_undefined);
    farg->access=a;
    fun->arguments[index].type=t;
    fun->arguments[index].access=a; }
    fun->arguments[index].access=a; 
    call_active(*c,Access_read+Access_constant,EARG(e,i));}
  Expression_set_void_result(e); }


static Void arg_meta(struct Expression *e) {
  arg_type_meta(e,Access_auto); }

static Void arg_r_meta(struct Expression *e) {
  arg_type_meta(e,Ar|Access_force_byaddress); }

static Void arg_rw_meta(struct Expression *e) {
  arg_type_meta(e,Arw); }

static Void arg_w_meta(struct Expression *e) {
  arg_type_meta(e,Aw); }

static Void arg_R_meta(struct Expression *e) {
  arg_type_meta(e,AwmR); }

static Void arg_RW_meta(struct Expression *e) {
  arg_type_meta(e,AwmRW); }

static Void arg_C_meta(struct Expression *e) {
  arg_type_meta(e,AwmC); }

static Void oarg_meta(struct Expression *e) {
  arg_type_meta(e,Access_auto|Access_object); }

static Void oarg_rw_meta(struct Expression *e) {
  arg_type_meta(e,Arw|Access_object); }

static Void oarg_w_meta(struct Expression *e) {
  arg_type_meta(e,Aw|Access_object); }

static Void oarg_R_meta(struct Expression *e) {
  arg_type_meta(e,AwmR|Access_object); }

static Void oarg_RW_meta(struct Expression *e) {
  arg_type_meta(e,AwmRW|Access_object); }

static Void oarg_C_meta(struct Expression *e) {
  arg_type_meta(e,AwmC|Access_object); }


/*
doc
  ['var' function inside a function definition (that means defining local variables, not global ones)]
*/

static struct Argument *local_variable(struct Expression *e,struct Str *name,struct Type *type) {
static struct Argument *local_variable(struct Expression *e,struct Expression *eident,struct Str *name,struct Type *type) {
  struct Function *function; struct List *locals; 
  struct LocalVariable *l; struct Argument *a;
  Arrow *c; struct Str temp;
  Arrow *c; struct Str temp; Arrow la;

  function=current_function();
  if(function==null) {
    error_notifyn(error_id_compile,Z,"You can define local variables outside functions",END);
    return null; }
  for(c=Module_first(e->module,name); *c!=null; c=Module_next(e->module,name,c))
    if(entry_type(*c)==G.type_LocalVariable) {
      l=(struct LocalVariable *)*c;
      if(l->function!=function)
        continue;
      a=l->body;
      if(a->where!=Argument_local) {
        error_notifyn(error_id_compile,Z,"The name is already reserved",END);
        return null;
      orif(a->type!=type)
        error_notifyn(error_id_compile,Z,"The local variable is already defined with another type",END);
        return null; }
      if (eident!=null)
        call_active(*c,Access_read|Access_constant,eident);
      return a; }
  l=(struct LocalVariable *)entry_new(G.type_LocalVariable); Str_copy(name,&l->name);
  la=entry_new(G.type_LocalVariable);l=(struct LocalVariable *)la; Str_copy(name,&l->name);
  a=argument(type,Argument_local); Str_copy(name,&a->name);
  l->function=function;
  Arrow_set((Arrow *)&l->body,a);
  l->access=Arw;
  Expression_define(e,&l->name,l,e->module);
  c=Module_first(e->module,Str_map_string(&temp,"pliant locals"));
  if(c==G.null_constant) {
    locals=(struct List *)entry_new(G.type_List);
    Module_define(e->module,&temp,locals);
  other
    check(entry_type(*c)==G.type_List);
    locals=(struct List *)*c; }
  List_append(locals,l);
  if (eident!=null)
    call_active(la,Access_read|Access_constant,eident);
  return a; }
static struct Argument *local_variable1(struct Expression *e,struct Str *name,struct Type *type ){
  return local_variable(e,null,name,type);}

static struct Argument *local_variable2(struct Expression *e,struct Expression *eident,struct Type *type) {
  return local_variable(e,eident,(struct Str *)Expression_pure_ident(eident),type);}

static Void var_meta(struct Expression *e) {
  struct Type *t; Int i; struct Str *n; struct Argument *a;
  struct Type *t; Int i; struct Argument *a;
  if(e->arguments.nb<2) return;
  t=Expression_constant(EARG(e,0),G.type_Type); if(t==null) return;
  for(i=1; i<e->arguments.nb; i++)
    if(Expression_pure_ident(EARG(e,i))==null) return;
  for(i=1; i<e->arguments.nb; i++) {
    n=(struct Str *)Expression_pure_ident(EARG(e,i));
    a=local_variable(e,n,t);
    a=local_variable2(e,EARG(e,i),t);
    if(a==null) return; }
  Expression_set_result(e,a,Arw); }


/*
doc
  ['return' function]
*/

static Void return_meta(struct Expression *e) {
  struct Function *fun;
  struct Expression *result;
  struct Type *type; struct Argument *targ;
  struct Argument *arg;
  struct Array *arguments; Arrow *c; struct Str temp;
  struct Instruction *i;
  fun=current_function();
  if(fun->nb_argres!=fun->nb_arg && e->arguments.nb==1) {
    type=fun->arguments[fun->nb_arg].type; if(type==null) return;
    result=EARG(e,0);
    if(!Expression_cast2(result,type,Function_flag_implicit|Function_flag_extension|Function_flag_reduction)) return;
    c=Module_first(e->module,Str_map_string(&temp,"pliant arguments"));
    arguments=(struct Array *)*c;
    arg=(struct Argument *)Array_get_index(arguments,fun->nb_arg);
    Expression_suckup(e,result);
    if(fun->arguments[fun->nb_arg].access&Access_mapped) {
      Expression_add(e,instruction(G.function_address_universal,result->result,arg,END));
    other
      targ=argument(G.type_Type,Argument_constant,type);
      Expression_add(e,instruction(G.function_copy_universal,result->result,arg,targ,END)); }
  other
    if(e->arguments.nb!=0) return; }
  i=instruction(G.function_i386_jump,END); Instruction_set_jump(i,(Address)-1);
  Expression_add(e,i);
  Expression_set_void_result(e); }


/*
doc
  [Other functions attributes: inline, generic, later, implicit, extension, reduction, allow_shared_result, has_side_effects, weak_definition, strong_definition, always_weak_definition, always_strong_definition, indirect, external, kernel_function, external_calling_convention]
*/

static Void set_flag_meta(struct Expression *e,Int flag) {
  if(e->arguments.nb!=0) return;
  current_function()->flags|=flag;
  Expression_set_void_result(e); }

static Void set_definition_meta(struct Expression *e,Int flag) {
  if(e->arguments.nb!=0) return;
  current_function()->definition=flag;
  Expression_set_void_result(e); }

static Void varargs_calling_convention_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_varargs); }

static Void external_calling_convention_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_external); }

static Void inline_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_inline_instructions); }

static Void generic_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_generic|Function_flag_has_side_effects); }

static Void later_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_later); }

static Void hidden_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_hidden); }

static Void implicit_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_implicit); }

static Void extension_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_extension); }

static Void reduction_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_reduction); }

static Void explicit_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_explicit); }

static Void allow_shared_result_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_allow_shared_result); }

static Void has_side_effects_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_has_side_effects); }

static Void has_no_side_effect_meta(struct Expression *e) {
  set_flag_meta(e,Function_flag_has_no_side_effect); }

static Void definition_weak_meta(struct Expression *e) {
  set_definition_meta(e,Definition_weak); }

static Void definition_strong_meta(struct Expression *e) {
  set_definition_meta(e,Definition_strong); }

static Void definition_always_weak_meta(struct Expression *e) {
  set_definition_meta(e,Definition_weak|Definition_always); }

static Void definition_always_strong_meta(struct Expression *e) {
  set_definition_meta(e,Definition_strong|Definition_always); }



static Void indirect_meta(struct Expression *e) {
  struct Function *fun; struct FunctionPrototype *a;
  struct FunctionPrototype *result; struct FunctionPrototype memo;
  fun=current_function();
  if(e->arguments.nb!=0 || fun==null || fun->nb_arg==0) return;
  a=fun->arguments+fun->nb_arg-1;
  if(a->type!=G.type_Function) return;
  fun->nb_arg--; fun->nb_argres--;
  if(fun->nb_argres>fun->nb_arg) {
    result=fun->arguments+fun->nb_argres;
    memory_copy(a,&memo,sizeof(struct FunctionPrototype));
    memory_copy(result,a,sizeof(struct FunctionPrototype)); }
  fun->flags&=~Function_flag_inline_instructions;
  Function_terminate_arguments_prototypes(fun,Function_flag_indirect|Function_flag_inline_binary|Function_flag_has_side_effects);
  fun->nb_arg++; fun->nb_argres++;
  if(fun->nb_argres>fun->nb_arg) {
    memory_copy(a,result,sizeof(struct FunctionPrototype));
    memory_copy(&memo,a,sizeof(struct FunctionPrototype)); }
  Function_code_immediat(fun,0x16FF,2);
  a->cpu_register=Register_ESI;
  Expression_set_void_result(e); }


#ifndef _STATIC_
  static Void external_meta(struct Expression *e) {
    struct Function *fun; struct Str *dllname,*funname; Int i;
    struct FunctionName *fn;
    if(e->arguments.nb!=2 || (dllname=(struct Str *)Expression_constant(EARG(e,0),G.type_Str))==null || (funname=(struct Str *)Expression_constant(EARG(e,1),G.type_Str))==null )
      return;
    fun=current_function();
    for(i=0; i<fun->nb_argres; i++)
      if(fun->arguments[i].type==null) {
        error_notifyn(error_id_compile,Z,"Type of parameter ",S,&fun->arguments[i].name,Z," is not defined !",END);
        return; }      
    fun->exe=external_function_address(dllname,funname);
    fun->flags&=~(Function_flag_inline_instructions|Function_flag_pliant_code_generator);
    Function_terminate_arguments_prototypes(fun,Function_flag_external|Function_flag_has_side_effects);
    if(fun->externals==null)
      Arrow_set(&fun->externals,entry_new(G.type_List));
    check(entry_type(fun->externals)==G.type_List);
    fn=entry_new(G.type_FunctionName);
    Str_copy(dllname,&fn->dll_name);
    Str_copy(funname,&fn->function_name);
    List_append((struct List *)fun->externals,fn); 
    Expression_set_void_result(e); }
#endif

/*
doc
  [The 'restore_externals' function is responsible for updating external functions (the ones provided through DLLs) addresses when the Pliant each time a Pliant process is started.]
*/

#ifndef _STATIC_
  static Void restore_externals() {
    struct Function *f;
    Arrow *c; struct FunctionName *fn; struct FunctionExternal *e;
    struct Function *f2;
    struct Module module;
    Module_build(&module);
    for(f=G.first_function; f!=null; f=f->next_function)
      if((f->flags&Function_flag_external) && f->exe_size==0 && f->externals!=null && entry_type(f->externals)==G.type_List)
        for(c=List_first((struct List *)f->externals); c!=G.null_constant; c=List_next(c))
          if(entry_type(*c)==G.type_FunctionName) {
            fn=(struct FunctionName *)*c;
            f->exe=external_function_address(&fn->dll_name,&fn->function_name); }
    for(f=G.first_function; f!=null; f=f->next_function)
      if(f->externals!=null && entry_type(f->externals)==G.type_List)
        for(c=List_first((struct List *)f->externals); c!=G.null_constant; c=List_next(c))
          if(entry_type(*c)==G.type_FunctionExternal) {
            e=(struct FunctionExternal *)*c;
            if(entry_type(e->to)!=G.type_Function) continue;
            f2=(struct Function *)e->to;
            if(!(f2->flags&Function_flag_external)) continue;
            *(Int *)address_translate(f->exe,e->code_offset)=integer_from_address(f2->exe)-integer_from_address(f->exe)-(e->code_offset+sizeof(Int)); }
    Module_destroy(&module); }
#endif


#if defined(_i386_) && defined(_LINUX_API_)
  static Void kernel_function_meta(struct Expression *e) {
    struct Function *fun; Int *number;
    if(e->arguments.nb!=1 || (number=(Int *)Expression_constant(EARG(e,0),G.type_Int))==null)
      return;
    fun=current_function();
    Function_code_immediat(fun,0xB8,1);
    Function_code_immediat(fun,*number,sizeof(Int));
    Function_code_immediat(fun,0x80CD,2);
    fun->flags&=~(Function_flag_inline_instructions|Function_flag_pliant_code_generator);
    Function_terminate_arguments_prototypes(fun,Function_flag_kernel|Function_flag_inline_binary|Function_flag_has_side_effects); 
    Expression_set_void_result(e); }
#endif



/*
doc
  ['function' and 'method' functions]
*/

static Void function_meta2(struct Expression *e,Bool method) {
  struct Function *function,*later; struct List hidden;
  struct Module *module; Address mark;
  struct Array *arguments; struct List *locals;
  struct GeneratorContext *gc;
  struct Expression *body;
  Int nb_arg,nb_res; Bool method_set;
  Int i,j; struct Argument *barg; struct LocalVariable *farg;
  struct Relation relation; struct Instruction *i1,*i2; Arrow *r,*r2,*r3,*r4;
  struct Str *name; struct Str temp;
  #ifdef _TIMER_
    Int old;
  #endif
  #ifdef _CHECK_
    Char buffer1[16],buffer2[16]; struct Str temp2;
  #endif
  if(e->arguments.nb<(method ? 3 : 2))
    return;
  for(i=0; i<e->arguments.nb-1; i++)
    if(Expression_pure_ident(EARG(e,i))==null) return;
  if(compare_str((struct Str *)EARG(e,e->arguments.nb-1)->value,Str_map_string(&temp,"{}"))!=compare_equal) return;
  module=e->module; check(module!=null);
  function=entry_new(G.type_Function);
  Str_concat(&function->name,Z,method && Str_len((struct Str *)EARG(e,method ? 1 : 0)->value)!=0 ? ". " : "",S,(struct Str *)EARG(e,method ? 1 : 0)->value,END);
  function->flags|=G.default_function_flags|Function_flag_under_construction;
  ListingPosition_copy(&e->position,&function->position);
  List_build(&hidden);
  for(r=Module_first(module,&function->name); r!=G.null_constant; r=Module_next(module,&function->name,r)) {
    later=(struct Function *)*r;
    if(entry_type(later)==G.type_Function && (later->flags&Function_flag_later) && !(later->flags&Function_flag_hidden)) {
      later->flags|=Function_flag_hidden;
      List_append(&hidden,later); } }
  Expression_define(e,&function->name,function,Module_actual(e->module));
  nb_arg=e->arguments.nb-2,nb_res=0,method_set=false;
  if(nb_arg>=(method ? 3 : 2) && compare_str((struct Str *)EARG(e,nb_arg-1)->value,Str_map_string(&temp,"->"))==compare_equal)
    nb_arg-=2,nb_res=1;
  if(method && nb_arg>=2 && compare_str((struct Str *)EARG(e,nb_arg-1)->value,Str_map_string(&temp,":="))==compare_equal) {
    nb_arg--,method_set=true;
    Str_concat(&function->name,S,&function->name,Z," :=",END); }
  Function_define_arguments_prototypes(function,nb_arg,nb_res);
  mark=Module_mark(module);
  Module_define(module,Str_map_string(&temp,"pliant function"),function);
  arguments=(struct Array *)entry_new(G.type_Array);
  Array_resize(arguments,nb_arg+nb_res);
  Module_define(module,Str_map_string(&temp,"pliant arguments"),arguments);
  locals=(struct List *)entry_new(G.type_List);
  Module_define(module,Str_map_string(&temp,"pliant locals"),locals);
  for(i=0; i<nb_arg+nb_res; i++) {
    if(method && i==0)
      j=0;
    eif(method_set && i==nb_arg-1)
      j=i+2;
    eif(i<nb_arg)
      j=i+1;
    else
      j=e->arguments.nb-2;
    name=(struct Str *)Expression_pure_ident(EARG(e,j));
    Str_copy(name,&function->arguments[i].name);
    barg=(struct Argument *)entry_new(G.type_Argument);
    Str_copy(name,&barg->name);
    farg=(struct LocalVariable *)entry_new(G.type_LocalVariable);
    Str_copy(name,&farg->name);
    farg->function=function;
    Arrow_set((Arrow *)&farg->body,barg);
    Module_define(module,name,farg);
    Array_set_index(arguments,i,barg);
    List_append(locals,farg); }
  body=EARG(e,e->arguments.nb-1);
  Expression_compile(body);
  if(!error_notified())
    for(i=0; i<nb_arg+nb_res; i++)
      if(function->arguments[i].type==null) {
       error_notifyn(error_id_compile,Z,"Type of parameter ",S,&function->arguments[i].name,Z," is not defined !",END);
        break; }
  if((function->flags&Function_flag_inline_instructions) && !error_notified()) {
    Relation_build(&relation); Relation_set_flags(&relation,4);
    for(i=0; i<nb_arg+nb_res; i++)
      Arrow_set((Arrow *)&function->arguments[i].inline_argument,Argument_copy(Array_get_index(arguments,i),&relation));
    for(r=List_first(&body->instructions); *r!=null; r=List_next(r)) {
      i1=Instruction_copy((struct Instruction *)*r,&relation);
      List_append(&function->inline_instructions,i1); }
    i1=instruction(G.function_do_nothing,END);
    List_append(&function->inline_instructions,i1);
    Relation_define(&relation,(Address)-1,null,i1);
    for(r=List_first(&function->inline_instructions); r!=G.null_constant; r=List_next(r)) {
      i2=(struct Instruction *)*r;
      if(i2->jump==null) continue;
      i2->jump=Relation_query(&relation,i2->jump,null); check(i2->jump!=null); }
    Relation_destroy(&relation); }
  if(function->exe==null) {
    if(!error_notified()) {
      Function_terminate_arguments_prototypes(function,0);
      #ifdef _TIMER_
        old=timer_set(timer_optimize);
      #endif
      gc=(struct GeneratorContext *)entry_new(G.type_GeneratorContext); entry_lock(gc);
      if((function->flags&Function_flag_generic) && nb_arg==0)
        error_notifyn(error_id_compile,Z,"Generic function ",S,&function->name,Z," has no parameter !",END);
      GeneratorContext_setup(gc,body,function);
      GeneratorContext_optimize(gc);
      entry_unlock(gc);
      #ifdef _TIMER_
        timer_set(old);
      #endif
      Function_watch_generic(function);
      if(function->flags&Function_flag_has_no_side_effect)
        function->flags&=~Function_flag_has_side_effects; }
  other
    check(function->flags&(Function_flag_inline_binary|Function_flag_external));
    check(!(function->flags&Function_flag_inline_instructions)); }
  Module_rewind(module,mark); 
  for(r=List_first(&hidden); r!=G.null_constant; r=List_next(r)) {
    later=(struct Function *)*r; check(entry_type(later)==G.type_Function);
    later->flags&=~Function_flag_hidden; }
  List_destroy(&hidden);
  if(error_notified()) {
    Str_build(&temp); Str_copy(&function->name,&temp);
    Dictionary_remove(G.general_dictionary,&temp,function);
    Str_destroy(&temp);
    return; }
  for(r=Module_first(module,&function->name); r!=G.null_constant; r=r2) {
    r2=Module_next(module,&function->name,r);
    later=(struct Function *)*r;
    if(entry_type(later)==G.type_Function && (later->flags&(Function_flag_later|Function_flag_under_construction))) {
      Function_update_uses(later,function);
      if((later->flags&Function_flag_later) && later!=function) {
        Arrow_set(&later->externals,null);
        Dictionary_remove(G.general_dictionary,&function->name,later); } } }
  function->flags&=~Function_flag_under_construction;
  Expression_set_result(e,argument(G.type_Function,Argument_indirect,argument(G.type_Address,Argument_constant,entry(G.type_Address,function,END)),0),Arw);
  #ifdef _TIMER_
    bytes_count+=function->exe_size;
  #endif
  #ifdef _CHECK_
    if(G.verbose_level>=3) {
      struct Str s;
      Str_build(&s);
      ListingPosition_get(&function->position,&s);
      consolen(Z,"function ",S,&function->name,Z," at ",S,&s,Z," ",S,Str_map_area(&temp,buffer1,Int_str2((Int)function->exe,16,buffer1)),Z," ",S,Str_map_area(&temp2,buffer2,Int_str2((Int)function->exe+function->exe_size,16,buffer2)),EOL);
      Str_destroy(&s); }
  #endif
  }


static Void function_meta(struct Expression *e) {
  function_meta2(e,false); }

static Void method_meta(struct Expression *e) {
  function_meta2(e,true); }


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


/*
doc
  ['meta' function]
*/

static Void macro_meta(struct Expression *e) {
  struct Function *macro; struct Str *name;
  struct Module *module; Address mark;
  struct Array *arguments; struct List *locals;
  struct GeneratorContext *gc;
  struct Expression *body;
  Int i; struct Expression *ei;
  struct Argument *barg; struct LocalVariable *farg;
  struct Str temp;
  struct Str temp; Arrow c;
  #ifdef _TIMER_
    Int old;
  #endif
  if(e->arguments.nb!=3)
    return;
  for(i=0; i<2; i++)
    if(Expression_pure_ident(EARG(e,0))==null) return;
  macro=entry_new(G.type_Meta); entry_lock(macro);
  name=(struct Str *)Expression_pure_ident(EARG(e,0));
  Str_copy(name,&macro->name);
  ListingPosition_copy(&e->position,&macro->position);
  module=e->module; check(module!=null);
  mark=Module_mark(module);
  Module_define(module,Str_map_string(&temp,"pliant function"),macro);
  arguments=(struct Array *)entry_new(G.type_Array);
  Array_resize(arguments,1);
  Module_define(module,Str_map_string(&temp,"pliant arguments"),arguments);
  locals=(struct List *)entry_new(G.type_List);
  Module_define(module,Str_map_string(&temp,"pliant locals"),locals);
  /**/
  Function_define_argument_prototype(macro,G.type_Expression,Arw,Str_map_string(&temp,""),null);
  name=(struct Str *)Expression_pure_ident(EARG(e,1));
  Str_copy(name,&macro->arguments[0].name);
  barg=argument(G.type_Expression,Argument_undefined);
  farg=(struct LocalVariable *)entry_new(G.type_LocalVariable);
  c=entry_new(G.type_LocalVariable); farg=(struct LocalVariable *)c;
  call_active(c,Access_read+Access_constant,EARG(e,1));
  Str_copy(name,&farg->name);
  farg->function=macro;
  Arrow_set((Arrow *)&farg->body,barg);
  farg->access=Arw;
  Module_define(module,name,farg);
  Array_set_index(arguments,0,barg);
  List_append(locals,farg);
  /**/
  Function_terminate_arguments_prototypes(macro,0);
  #ifdef _TIMER_
    old=timer_set(timer_optimize);
  #endif
  gc=(struct GeneratorContext *)entry_new(G.type_GeneratorContext); entry_lock(gc);
  body=EARG(e,2);
  Expression_compile(body);
  if(!error_notified()) {
    GeneratorContext_setup(gc,body,macro);
    GeneratorContext_optimize(gc); }
  entry_unlock(gc);
  #ifdef _TIMER_
    timer_set(old);
  #endif
  Module_rewind(module,mark); 
  if(!error_notified()) {
    Expression_define(e,&macro->name,macro,Module_actual(e->module));
    Expression_set_void_result(e);
    #ifdef _TIMER_
      bytes_count+=macro->exe_size;
    #endif
    }
  entry_unlock(macro); }


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

/*
doc
  section "type"
*/

static struct Type *current_type() {
  struct Str temp; Arrow *c;
  c=Dictionary_first(G.general_dictionary,Str_map_string(&temp,"pliant type"));
  check(entry_type(*c)==G.type_Type);
  return (struct Type *)*c; }


/*
doc
  ['field' function]
*/

static Void field_meta(struct Expression *e) {
  struct Type *type;
  struct Type *t; Address iv;
  Int nb_arg,i;
  struct Str *n; Int o; struct Str temp;
  if(e->arguments.nb<2) return;
  nb_arg=e->arguments.nb;
  if(nb_arg>=3 && compare_str((struct Str *)EARG(e,nb_arg-2)->value,Str_map_string(&temp,"<-"))==compare_equal)
    nb_arg-=2;
  for(i=1; i<nb_arg; i++)
    if(Expression_pure_ident(EARG(e,i))==null) return;
  t=Expression_constant(EARG(e,0),G.type_Type); if(t==null) return;
  iv=null;
  if(nb_arg!=e->arguments.nb) {
    iv=Expression_constant2(EARG(e,nb_arg+1),t,Function_flag_implicit|Function_flag_extension|Function_flag_reduction);
    if(iv==null) return; }
  type=current_type();
  for(i=1; i<nb_arg; i++) {
    n=(struct Str *)Expression_pure_ident(EARG(e,i));
    o=type->size;
    Type_define_field(type,t,n,iv);
    C_field(type,Str_string(n),Module_actual(e->module),t,o,AwmC); } 
  Expression_set_void_result(e); }


/*
doc
  [Other types attributes: packed, later, generic_level]
*/

static Void packed_meta(struct Expression *e) {
  struct Type *type;
  if(e->arguments.nb!=0) return;
  type=current_type();
  type->flags|=Type_flag_packed;
  Expression_set_void_result(e); }

static Void later_type_Meta(struct Expression *e) {
  struct Type *type;
  if(e->arguments.nb!=0) return;
  type=current_type();
  if(type->size==0) type->flags&=~Type_flag_scalar;
  type->flags|=Type_flag_later;
  Expression_set_void_result(e); }


static Void generic_level_meta(struct Expression *e) {
  struct Type *type; Int *level;
  if(e->arguments.nb!=1) return;
  level=(Int *)Expression_constant(EARG(e,0),G.type_Int); if(level==null) return;
  type=current_type();
  type->generic_level=*level;
  Expression_set_void_result(e); }


/*
doc
  ['type' function]
*/

static Void type_meta(struct Expression *e) {
  struct Type *type;
  struct Module *module; Address mark;
  struct Str temp; struct Str *name; struct Expression *ei;
  Arrow *r;
  Arrow *r; Arrow c;
  if(e->arguments.nb!=2) return;
  if((name=Expression_pure_ident(EARG(e,0)))==null) return;
  if(compare_str((struct Str *)EARG(e,1)->value,Str_map_string(&temp,"{}"))!=compare_equal) return;
  module=e->module;
  type=null;
  for(r=Module_first(module,name); r!=G.null_constant; r=Module_next(module,name,r))
    if(entry_type(*r)==G.type_Type && (((struct Type *)*r)->flags&Type_flag_later)) {
      type=(struct Type *)*r;
      type->flags&=~Type_flag_later; 
      if(type->size==0) type->flags|=Type_flag_scalar;
      entry_lock(type);
      Dictionary_remove(G.general_dictionary,name,type);
      Expression_define(e,name,type,Module_actual(e->module));
      entry_unlock(type);
      break; }   
  if(type==null) {
    type=entry_new(G.type_Type);
    c=entry_new(G.type_Type);type=(struct Type *)c;
    Str_copy(name,&type->name);
    Expression_define(e,name,type,Module_actual(e->module)); }
    Expression_define(e,name,type,Module_actual(e->module)); 
    call_active(c,Access_read+Access_constant,EARG(e,0)); }
  else {
    call_active(*r,Access_read+Access_constant,EARG(e,0)); }
  ListingPosition_copy(&e->position,&type->position);
  mark=Module_mark(module);
  Module_define(module,Str_map_string(&temp,"pliant type"),type);
  Expression_compile(EARG(e,1));
  if(!error_notified()) {
    if(!(type->flags&Type_flag_later)) {
      Type_terminate_fields(type);
      Type_may_be(G.type_Universal,type); }
  other
    Dictionary_remove(G.general_dictionary,name,type); }
  Module_rewind(module,mark); 
  Expression_set_result(e,argument(G.type_Type,Argument_indirect,argument(G.type_Address,Argument_constant,entry(G.type_Address,type,END)),0),Arw); }