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 an
// modify it under the terms of the GNU General Public Licen
// as published by the Free Software Foundation.
// 
// This program is distributed in the hope that it will be u
// but WITHOUT ANY WARRANTY; without even the implied warran
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
// GNU General Public License for more details.
// 
// You should have received a copy of the GNU General Public
// version 2 along with this program; if not, write to the F
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA


static Void arg_type_meta(struct Expression *e,Int access) {
  struct Type *t; struct Function *fun; struct Array *argume
  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) 
  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(&te
  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_LocalVar
      error_notifyn(error_id_compile,S,name,Z," is not an ar
      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 ar
      return; }
    a=(access&Access_auto ? (index<fun->nb_arg ? Ar : AwR)|(
    tt=(a&Access_mapped ? pointerto(t) : t);
    if(farg->body->type!=null && (farg->body->type!=tt || fa
      error_notifyn(error_id_compile,Z,"Type of ",S,name,Z,"
      return; }
    Argument_locate(farg->body,tt,Argument_undefined);
    farg->access=a;
    fun->arguments[index].type=t;
// Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
//
// This program is free software; you can redistribute it an
// modify it under the terms of the GNU General Public Licen
// as published by the Free Software Foundation.
// 
// This program is distributed in the hope that it will be u
// but WITHOUT ANY WARRANTY; without even the implied warran
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
// GNU General Public License for more details.
// 
// You should have received a copy of the GNU General Public
// version 2 along with this program; if not, write to the F
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA


static Void arg_type_meta(struct Expression *e,Int access) {
  struct Type *t; struct Function *fun; struct Array *argume
  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) 
  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(&te
  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_LocalVar
      error_notifyn(error_id_compile,S,name,Z," is not an ar
      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 ar
      return; }
    a=(access&Access_auto ? (index<fun->nb_arg ? Ar : AwR)|(
    tt=(a&Access_mapped ? pointerto(t) : t);
    if(farg->body->type!=null && (farg->body->type!=tt || fa
      error_notifyn(error_id_compile,Z,"Type of ",S,name,Z,"
      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); }



  Expression_set_void_result(e); }



static struct Argument *local_variable(struct Expression *e,
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;
  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 v
    return null; }
  for(c=Module_first(e->module,name); *c!=null; c=Module_nex
    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 alread
        return null;
      orif(a->type!=type)
        error_notifyn(error_id_compile,Z,"The local variable
        return null; }
  function=current_function();
  if(function==null) {
    error_notifyn(error_id_compile,Z,"You can define local v
    return null; }
  for(c=Module_first(e->module,name); *c!=null; c=Module_nex
    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 alread
        return null;
      orif(a->type!=type)
        error_notifyn(error_id_compile,Z,"The local variable
        return null; }
      if (eident!=null)
        call_active(*c,Access_read|Access_constant,eident);
      return a; }
      return a; }
  l=(struct LocalVariable *)entry_new(G.type_LocalVariable);
  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 loca
  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);
  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 loca
  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; }
  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) {
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) 
  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++) {
  if(e->arguments.nb<2) return;
  t=Expression_constant(EARG(e,0),G.type_Type); if(t==null) 
  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); }



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;
    if(a==null) return; }
  Expression_set_result(e,a,Arw); }



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
  arguments=(struct Array *)entry_new(G.type_Array);
  Array_resize(arguments,1);
  Module_define(module,Str_map_string(&temp,"pliant argument
  locals=(struct List *)entry_new(G.type_List);
  Module_define(module,Str_map_string(&temp,"pliant locals")
  /**/
  Function_define_argument_prototype(macro,G.type_Expression
  name=(struct Str *)Expression_pure_ident(EARG(e,1));
  Str_copy(name,&macro->arguments[0].name);
  barg=argument(G.type_Expression,Argument_undefined);
  #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
  arguments=(struct Array *)entry_new(G.type_Array);
  Array_resize(arguments,1);
  Module_define(module,Str_map_string(&temp,"pliant argument
  locals=(struct List *)entry_new(G.type_List);
  Module_define(module,Str_map_string(&temp,"pliant locals")
  /**/
  Function_define_argument_prototype(macro,G.type_Expression
  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_LocalVariabl
  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_GeneratorCo
  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->
    Expression_set_void_result(e);
    #ifdef _TIMER_
      bytes_count+=macro->exe_size;
    #endif
    }
  entry_unlock(macro); }



static Void type_meta(struct Expression *e) {
  struct Type *type;
  struct Module *module; Address mark;
  struct Str temp; struct Str *name; struct Expression *ei;
  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_GeneratorCo
  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->
    Expression_set_void_result(e);
    #ifdef _TIMER_
      bytes_count+=macro->exe_size;
    #endif
    }
  entry_unlock(macro); }



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_stri
  module=e->module;
  type=null;
  for(r=Module_first(module,name); r!=G.null_constant; r=Mod
    if(entry_type(*r)==G.type_Type && (((struct Type *)*r)->
      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) {
  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_stri
  module=e->module;
  type=null;
  for(r=Module_first(module,name); r!=G.null_constant; r=Mod
    if(entry_type(*r)==G.type_Type && (((struct Type *)*r)->
      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);
    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"),t
  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_indi




  ListingPosition_copy(&e->position,&type->position);
  mark=Module_mark(module);
  Module_define(module,Str_map_string(&temp,"pliant type"),t
  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_indi