Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/compiler/expression/expression.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


// 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


FUNCTION Void Expression_copy_properties(struct Expression *src,struct Expression *dest) {
  Int i;
  Dictionary_copy(&src->properties,&dest->properties);
  #ifdef _CHECK_
    check(dest->arguments.nb==src->arguments.nb);
    for(i=0; i<dest->arguments.nb; i++) 
      check(entry_type(Array_get_index(&dest->arguments,i))==G.type_Expression);
  #endif
    for (i=0; i<dest->arguments.nb;i++)
      Expression_copy_properties(EARG(src,i),EARG(dest,i)); } 


FUNCTION Void Expression_copy(struct Expression *src,struct 
  Int i;
  Arrow_copy((Arrow *)&src->module,(Arrow *)&dest->module);
  ListingPosition_copy(&src->position,&dest->position);
  Dictionary_copy(&src->properties,&dest->properties);
  Arrow_copy(&src->value,&dest->value);
  Array_copy(&src->arguments,&dest->arguments);
  #ifdef _CHECK_
    for(i=0; i<dest->arguments.nb; i++) 
      check(entry_type(Array_get_index(&dest->arguments,i))=
  #endif
  List_copy(&src->instructions,&dest->instructions);
  Arrow_copy((Arrow *)&src->result,(Arrow *)&dest->result);
  dest->access=src->access;
  List_copy(&src->backtracking,&dest->backtracking);
  Arrow_copy((Arrow *)&src->last_uncasted_instruction,(Arrow
  Arrow_copy((Arrow *)&src->uncasted_result,(Arrow *)&dest->
  dest->uncasted_access=src->uncasted_access;
  dest->cast_level=src->cast_level;
  Arrow_copy((Arrow *)&src->op,(Arrow *)&dest->op);
  Arrow_copy((Arrow *)&src->closeop,(Arrow *)&dest->closeop)
  Str_copy(&src->error_message,&dest->error_message); } 



FUNCTION Void Expression_compile_step4(struct Expression *e,
FUNCTION Void Expression_copy(struct Expression *src,struct 
  Int i;
  Arrow_copy((Arrow *)&src->module,(Arrow *)&dest->module);
  ListingPosition_copy(&src->position,&dest->position);
  Dictionary_copy(&src->properties,&dest->properties);
  Arrow_copy(&src->value,&dest->value);
  Array_copy(&src->arguments,&dest->arguments);
  #ifdef _CHECK_
    for(i=0; i<dest->arguments.nb; i++) 
      check(entry_type(Array_get_index(&dest->arguments,i))=
  #endif
  List_copy(&src->instructions,&dest->instructions);
  Arrow_copy((Arrow *)&src->result,(Arrow *)&dest->result);
  dest->access=src->access;
  List_copy(&src->backtracking,&dest->backtracking);
  Arrow_copy((Arrow *)&src->last_uncasted_instruction,(Arrow
  Arrow_copy((Arrow *)&src->uncasted_result,(Arrow *)&dest->
  dest->uncasted_access=src->uncasted_access;
  dest->cast_level=src->cast_level;
  Arrow_copy((Arrow *)&src->op,(Arrow *)&dest->op);
  Arrow_copy((Arrow *)&src->closeop,(Arrow *)&dest->closeop)
  Str_copy(&src->error_message,&dest->error_message); } 



FUNCTION Void Expression_compile_step4(struct Expression *e,
  struct Type *t; TypeCompilePrototype compilefun; struct Ar
  struct ActionRecord ca;
  struct ErrorRecord err;
  struct Str s;
  if(Expression_is_compiled(e) || (e->access&Access_nocompil
  ActionRecord_build(&ca);
  Str_build(&s);
  ListingPosition_get(&e->position,&s);
  action_push_recordn(&ca,Z,"compile ",S,&s,END);
  Str_destroy(&s);
  if(e->result!=null)
    error_notifyn(error_id_corrupted,Z,"The expression is al
  if(List_first(&e->instructions)!=G.null_constant)
    error_notifyn(error_id_corrupted,Z,"Expression instructi
  if(e->module==null)
    error_notifyn(error_id_corrupted,Z,"The expression is no
  #ifdef _CHECK_
    if(++recursion>=1024)
      error_notifyn(error_id_starvation,Z,"Infinite compilin
  #endif
  if(!error_notified()) {
    ErrorRecord_build(&err);
    error_push_record(&err,error_id_compile);
  struct ActionRecord ca;
  struct ErrorRecord err;
  struct Str s;
  if(Expression_is_compiled(e) || (e->access&Access_nocompil
  ActionRecord_build(&ca);
  Str_build(&s);
  ListingPosition_get(&e->position,&s);
  action_push_recordn(&ca,Z,"compile ",S,&s,END);
  Str_destroy(&s);
  if(e->result!=null)
    error_notifyn(error_id_corrupted,Z,"The expression is al
  if(List_first(&e->instructions)!=G.null_constant)
    error_notifyn(error_id_corrupted,Z,"Expression instructi
  if(e->module==null)
    error_notifyn(error_id_corrupted,Z,"The expression is no
  #ifdef _CHECK_
    if(++recursion>=1024)
      error_notifyn(error_id_starvation,Z,"Infinite compilin
  #endif
  if(!error_notified()) {
    ErrorRecord_build(&err);
    error_push_record(&err,error_id_compile);
    t=entry_type(object);
    compilefun=Type_get_generic_method_executable(t,G.generi
    if(compilefun!=undefined_method) {
      compilefun(object,access,e);
      check(e->result==null || (e->access&(Access_read|Acces
    other
      arg=argument(entry_type(object),Argument_constant,obje
      active_type_Argument(arg,Access_read|Access_constant,e
      entry_unlock(arg); } 
    call_active(object,access,e);
    if(err.id==error_id_compile) {
      if(Str_len(&e->error_message)==0)
        Str_copy(&err.message,&e->error_message);
      err.id=error_id_noerror; 
      Expression_uncompile(e); }
    error_pull_record(&err);
    ErrorRecord_destroy(&err); }
  action_pull_record(&ca);
  ActionRecord_destroy(&ca);
  _check_( recursion--; ) }



    if(err.id==error_id_compile) {
      if(Str_len(&e->error_message)==0)
        Str_copy(&err.message,&e->error_message);
      err.id=error_id_noerror; 
      Expression_uncompile(e); }
    error_pull_record(&err);
    ErrorRecord_destroy(&err); }
  action_pull_record(&ca);
  ActionRecord_destroy(&ca);
  _check_( recursion--; ) }




FUNCTION Void Expression_uncompile(struct Expression *e) {
FUNCTION Void Expression_uncompile2(struct Expression *e) {
  Expression_uncast(e);
  Expression_rewind(e,null);
  Arrow_set((Arrow *)&e->result,null); e->access=0;
  Expression_uncast(e);
  Expression_rewind(e,null);
  Arrow_set((Arrow *)&e->result,null); e->access=0;
  Expression_backtrack(e);
  Expression_backtrack(e); }

FUNCTION Void Expression_uncompile(struct Expression *e) {  
  Expression_uncompile2(e);
  Dictionary_destroy(&e->properties);
  Dictionary_build(&e->properties); }



FUNCTION Address Expression_evaluate2(struct Expression *e,s
  Arrow result;
  struct Argument *a;
  struct Module *m; Address mark; struct Str temp;
  if(!Expression_cast2(e,type,cast_flags)) return null;
  Arrow_build(&result);
  if(!(type->flags&Type_flag_do_not_copy)) {
    Arrow_set(&result,entry_new(type));
    a=argument(type,Argument_indirect,argument(G.type_Addres
    Expression_add(e,instruction(G.function_copy_universal,e
  other
    a=argument(G.type_Address,Argument_indirect,argument(G.t
    Expression_add(e,instruction(G.function_arrow_universal,
  m=e->module; mark=Module_mark(m);
  Module_define(m,Str_map_string(&temp,"pliant function"),en
  Module_define(m,Str_map_string(&temp,"pliant arguments"),e
  Expression_execute(e);
  Module_rewind(m,mark);
  Dictionary_destroy(&e->properties);
  Dictionary_build(&e->properties); }



FUNCTION Address Expression_evaluate2(struct Expression *e,s
  Arrow result;
  struct Argument *a;
  struct Module *m; Address mark; struct Str temp;
  if(!Expression_cast2(e,type,cast_flags)) return null;
  Arrow_build(&result);
  if(!(type->flags&Type_flag_do_not_copy)) {
    Arrow_set(&result,entry_new(type));
    a=argument(type,Argument_indirect,argument(G.type_Addres
    Expression_add(e,instruction(G.function_copy_universal,e
  other
    a=argument(G.type_Address,Argument_indirect,argument(G.t
    Expression_add(e,instruction(G.function_arrow_universal,
  m=e->module; mark=Module_mark(m);
  Module_define(m,Str_map_string(&temp,"pliant function"),en
  Module_define(m,Str_map_string(&temp,"pliant arguments"),e
  Expression_execute(e);
  Module_rewind(m,mark);
  Expression_uncompile(e);
  Expression_uncompile2(e);
  if(result!=null)
    Expression_set_constant_result(e,result);
  Arrow_destroy(&result);
  return (e->result!=null && e->result->where==Argument_cons



  if(result!=null)
    Expression_set_constant_result(e,result);
  Arrow_destroy(&result);
  return (e->result!=null && e->result->where==Argument_cons