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 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 "'Expression' data type"
*/
 

INLINE struct Expression *EARG(struct Expression *e,Int index) {
  return (struct Expression *)Array_get_index(&e->arguments,index); }


FUNCTION Void Expression_build(struct Expression *e) {
  Arrow_build(&e->value);
  Array_build(&e->arguments);
  Arrow_build((Arrow *)&e->module);
  ListingPosition_build(&e->position);
  Dictionary_build(&e->properties);
  List_build(&e->instructions);
  Arrow_build((Arrow *)&e->result); e->access=0;
  List_build(&e->backtracking);
  Arrow_build((Arrow *)&e->last_uncasted_instruction);
  Arrow_build((Arrow *)&e->uncasted_result);
  e->cast_level=0;
  Arrow_build((Arrow *)&e->op);
  Arrow_build((Arrow *)&e->closeop);
  Str_build(&e->error_message); }


static Void Expression_rewind(struct Expression *e,struct Instruction *upto) {
  while(*List_last(&e->instructions)!=upto) {
    check(*List_last(&e->instructions)!=null);
    List_remove(&e->instructions,List_last(&e->instructions)); } }

FUNCTION Void Expression_destroy(struct Expression *e) {
  Arrow_destroy(&e->value);
  Array_destroy(&e->arguments);
  Arrow_destroy((Arrow *)&e->module);
  ListingPosition_destroy(&e->position);
  Dictionary_destroy(&e->properties);
  List_destroy(&e->instructions);
  Arrow_destroy((Arrow *)&e->result);
  List_destroy(&e->backtracking);
  Arrow_destroy((Arrow *)&e->last_uncasted_instruction);
  Arrow_destroy((Arrow *)&e->uncasted_result);
  Arrow_destroy((Arrow *)&e->op);
  Arrow_destroy((Arrow *)&e->closeop);
  Str_destroy(&e->error_message); }


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 Expression *dest) {
  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))==G.type_Expression);
  #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 *)&dest->last_uncasted_instruction);
  Arrow_copy((Arrow *)&src->uncasted_result,(Arrow *)&dest->uncasted_result);
  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_add(struct Expression *e,struct Instruction *instr) {
  #ifdef _CHECK_
    Int i; struct Argument *a; struct Str s;
    if(instr->next_instruction!=null || instr->previous_instruction!=null) {
      Str_build(&s);
      ListingPositions_get(&instr->position,&s);
      error_notifyn(error_id_unexpected,Z,"add: instruction is aready linked (instruction was generated at ",S,&s,Z,")",END);
      Str_destroy(&s); }
    for(i=0; i<instr->arguments.nb; i++) {
      a=(struct Argument *)instr->arguments.references[i];
      again:
      if(a->first_instruction!=null || a->last_instruction!=null) {
        Str_build(&s);
        ListingPositions_get(&instr->position,&s);
        error_notifyn(error_id_unexpected,Z,"add: argument is aready linked (instruction was generated at ",S,&s,Z,")",END);
        Str_destroy(&s); }
      if(a->where==Argument_indirect) {
        a=a->u.indirect.pointer; goto again; } }
  #endif
  if(error_notified()) return;
  List_append(&e->instructions,instr); }


FUNCTION Void Expression_set_result(struct Expression *e,struct Argument *a,Int access) {
  if(error_notified()) return;
  Arrow_set((Arrow *)&e->result,a); e->access=access;
  string_Str("",&e->error_message); }


FUNCTION Void Expression_set_constant_result(struct Expression *e,Arrow value) {
  Expression_set_result(e,argument(entry_type(value),Argument_constant,value),Access_read|Access_constant); }


FUNCTION Void Expression_set_void_result(struct Expression *e) {
  Expression_set_constant_result(e,entry_new(G.type_Void)); }


FUNCTION Void Expression_suckup(struct Expression *e,struct Expression *sub) {
  Arrow *c;
  if(error_notified()) return;
  for(c=List_first(&sub->instructions); c!=G.null_constant; c=List_next(c)) {
    #ifdef _CHECK_
      struct Instruction *instr=(struct Instruction *)*c; Int i; struct Argument *a; struct Str s;
      if(instr->next_instruction!=null || instr->previous_instruction!=null) {
        Str_build(&s);
        ListingPositions_get(&instr->position,&s);
        error_notifyn(error_id_unexpected,Z,"suckup: instruction is aready linked (instruction was generated at ",S,&s,Z,")",END);
        Str_destroy(&s); }
      for(i=0; i<instr->arguments.nb; i++) {
        a=(struct Argument *)instr->arguments.references[i];
        again:
        if(a->first_instruction!=null || a->last_instruction!=null) {
          Str_build(&s);
          ListingPositions_get(&instr->position,&s);
          error_notifyn(error_id_unexpected,Z,"suckup: argument is aready linked (instruction was generated at ",S,&s,Z,")",END);
          Str_destroy(&s); }
        if(a->where==Argument_indirect) {
          a=a->u.indirect.pointer; goto again; } }
    #endif
    List_append(&e->instructions,*c); }
  for(c=List_first(&sub->backtracking); c!=G.null_constant; c=List_next(c))
    List_append(&e->backtracking,*c); }


FUNCTION Void Expression_suckup_error(struct Expression *e,struct Expression *sub) {
  if(Str_len(&sub->error_message)!=0 && Str_len(&e->error_message)==0)
    Str_copy(&sub->error_message,&e->error_message); }


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


FUNCTION Void Expression_precompile_rewrite(struct Expression *e) {
  struct Str temp; Arrow *r; struct Function *f;
  for(r=Module_first(e->module,Str_map_string(&temp,"pliant precompile rewrite")); r!=G.null_constant; r=Module_next(e->module,&temp,r)) {
    check(entry_type(*r)==G.type_Function);
    f=(struct Function *)*r;
    ((PrecompileRewritePrototype)f->exe)(e); } }


FUNCTION Void Expression_postcompile_rewrite(struct Expression *e) {
  struct Str temp; Arrow *r; struct Function *f;
  for(r=Module_first(e->module,Str_map_string(&temp,"pliant postcompile rewrite")); r!=G.null_constant; r=Module_next(e->module,&temp,r)) {
    check(entry_type(*r)==G.type_Function);
    f=(struct Function *)*r;
    ((PostcompileRewritePrototype)f->exe)(e); } }


FUNCTION Void Expression_failedtocompile_rewrite(struct Expression *e) {
  struct Str temp; Arrow *r; struct Function *f;
  for(r=Module_first(e->module,Str_map_string(&temp,"pliant failedtocompile rewrite")); r!=G.null_constant; r=Module_next(e->module,&temp,r)) {
    check(entry_type(*r)==G.type_Function);
    f=(struct Function *)*r;
    ((FailedtocompileRewritePrototype)f->exe)(e); } }


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


FUNCTION Bool Expression_is_compiled(struct Expression *e) {
  return e->result!=null; }

FUNCTION Void _EXTERNAL_ Expression_compile(struct Expression *e) {
  Int i; struct Expression *sub; struct Str t;
  Expression_compile_step2(e);
  if(Expression_is_compiled(e) || error_notified()) return;
  e->access |= Access_nocompile;
  for(i=0; i<e->arguments.nb; i++)
    Expression_suckup_error(e,EARG(e,i));
  if(Str_len(&e->error_message)!=0) {
    error_renotify(error_id_compile,null,&e->error_message);
    return; }
  if(entry_type(e->value)!=G.type_Ident) {
    Str_concat(&e->error_message,Z,"Failed to compile an object with type ",S,&entry_type(e->value)->name,END);
  other
    Str_concat(&e->error_message,Z,"Failed to compile ",S,(struct Str *)e->value,END); }
  Str_addz("   (",&e->error_message);
  for(i=0; i<e->arguments.nb; i++) {
    if(i>0)
      Str_addz("  ",&e->error_message);
    sub=EARG(e,i);
    if(sub->result==null) {
      if(entry_type(sub->value)==G.type_Ident && sub->arguments.nb==0) {
        Str_addz("'",&e->error_message);
        Str_add((struct Str *)sub->value,&e->error_message);
        Str_addz("'",&e->error_message);
      other
        Str_addz("?",&e->error_message); }
    other
      if(sub->uncasted_result!=null) {
        Str_add(&sub->uncasted_result->type->name,&e->error_message);
        Str_addz("=>",&e->error_message); }
      Str_add(&sub->result->type->name,&e->error_message);
      Str_addz(" ",&e->error_message);
      if(sub->access&Access_read)
        Str_addz("r",&e->error_message);
      if(sub->access&Access_write)
        Str_addz("w",&e->error_message);
      if(sub->access&Access_constant)
        Str_addz("c",&e->error_message); } }
  Str_addz(")\n  compile ",&e->error_message);
  Str_build(&t);
  ListingPosition_get(&e->position,&t);
  Str_add(&t,&e->error_message);
  Str_destroy(&t);
  error_notify(error_id_compile,null,&e->error_message); }
 

FUNCTION Void Expression_compile_step2(struct Expression *e) {
  struct Expression *node,*args; 
  Arrow *c; struct Instruction *instr;
  if(Expression_is_compiled(e) || error_notified()) return;
  if(!Expression_is_compiled(e) && !error_notified())
    Expression_compile_step3(e);
  if(e->arguments.nb!=0 && !Expression_is_compiled(e) && !error_notified()) {
    // try to compile e with no arguments, then the result with the arguments
    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);
    Expression_compile_step3(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_set_result(e,args->result,args->access); }
      entry_unlock(args); }
    entry_unlock(node); }
  if(!Expression_is_compiled(e) && !error_notified())
    Expression_failedtocompile_rewrite(e);
  // add missing instructions positions
  for(c=List_first(&e->instructions); c!=G.null_constant; c=List_next(c)) {
    check(entry_type(*c)==G.type_Instruction);
    instr=(struct Instruction *)*c;
    if(ListingPositions_size(&instr->position)==0)
      cast_ListingPositions(&e->position,&instr->position); }
  // postcompile rewrite
  if(Expression_is_compiled(e) && !error_notified())
    Expression_postcompile_rewrite(e); }


FUNCTION Void Expression_compile_step3(struct Expression *e) {
  Expression_compile_step4(e,e->value,Access_read|Access_constant); }

_check_( static Int recursion=0; )

FUNCTION Void Expression_compile_step4(struct Expression *e,Arrow object,Int access) {
  struct Type *t; TypeCompilePrototype compilefun; struct Argument *arg;
  struct ActionRecord ca;
  struct ErrorRecord err;
  struct Str s;
  if(Expression_is_compiled(e) || (e->access&Access_nocompile)) return;
  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 already compiled",END);
  if(List_first(&e->instructions)!=G.null_constant)
    error_notifyn(error_id_corrupted,Z,"Expression instructions list is not empty",END);
  if(e->module==null)
    error_notifyn(error_id_corrupted,Z,"The expression is not linked to a module",END);
  #ifdef _CHECK_
    if(++recursion>=1024)
      error_notifyn(error_id_starvation,Z,"Infinite compiling recursion",END);
  #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.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); } 
    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--; ) }


static Void backtrack_definition(struct BacktrackingDefinition *d) {
  Dictionary_remove(G.general_dictionary,&d->name,d->object); }

FUNCTION Void BacktrackingAction_destroy(struct BacktrackingAction *a) {
  if(a->function!=null)
    ((Void (*)(Address parameter))a->function->exe)(a->parameter); }

FUNCTION Void BacktrackingAction_cut(struct BacktrackingAction *a) {
  Arrow_set((Arrow *)&a->function,null); }

FUNCTION Void Expression_backtrack(struct Expression *e) { /// section "backtrack"
  List_destroy(&e->backtracking); List_build(&e->backtracking); }


FUNCTION Void Expression_cut_backtracking(struct Expression *e) {
  Arrow *c; struct BacktrackingAction *a;
  for(c=List_first(&e->backtracking); c!=G.null_constant; c=List_next(c)) {
    a=(struct BacktrackingAction *)*c; 
    check(entry_type(a)==G.type_BacktrackingAction);
    BacktrackingAction_cut(a); } }


FUNCTION Void Expression_define(struct Expression *e,struct Str *name,Arrow object,struct Module *module) {
  struct BacktrackingDefinition *d; struct BacktrackingAction *a;
  Module_define(module,name,object);
  d=(struct BacktrackingDefinition *)entry_new(G.type_BacktrackingDefinition);
  Str_copy(name,&d->name);
  Arrow_set(&d->object,object);
  a=(struct BacktrackingAction *)entry_new(G.type_BacktrackingAction);
  Arrow_set((Arrow *)&a->function,G.function_backtrack_definition);
  Arrow_set(&a->parameter,d);
  List_append(&e->backtracking,a); }


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_backtrack(e);
  Expression_backtrack(e); }

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


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


static Bool Expression_test_cast_to(struct Type *type,struct Type *wished_type,Int flags,struct Module *module,struct Type **excluded,Int nb_excluded,struct Function **next_function,struct Type **next_type,Int *path_length,Int *path_nb) {
  struct Str name;
  Arrow *r; struct Function *f; Int u;
  struct Type *t,*test_type; struct Function *test_function; Int test_length,test_nb;
  if(wished_type==type) {
    *next_function=null,*next_type=null,*path_length=0,*path_nb=test_nb=1;
    return true; }
  for(u=0; u<nb_excluded; u++)
    if(wished_type==excluded[u]) return false;
  excluded[nb_excluded]=wished_type;
  *path_length=int_max,*path_nb=0;
  Type_recurse_may_be(wished_type);
  for(r=List_first(&wished_type->maybe); r!=G.null_constant; r=List_next(r)) {
    t=(struct Type *)*r;
    if(!Expression_test_cast_to(type,t,flags,module,excluded,nb_excluded+1,&test_function,&test_type,&test_length,&test_nb)) continue;
    if(test_length<*path_length) {
      *next_function=test_function,*next_type=test_type,*path_length=test_length,*path_nb=test_nb;
    orif(test_length==*path_length)
      *path_nb+=test_nb; } }
  Str_build(&name); Str_concat(&name,Z,"cast ",S,&wished_type->name,END);
  for(r=Dictionary_first(G.general_dictionary,&name); r!=G.null_constant; r=Dictionary_next(G.general_dictionary,&name,r)) {
    if(entry_type(*r)!=G.type_Function) continue;
    f=(struct Function *)*r;
    if(flags!=0 && !(f->flags&flags)) continue;
    if(f->nb_argres!=2 || f->arguments[1].type!=wished_type) continue;
    if(!Module_is_included(module,struct_from_field(DictNode2,object,r)->module)) continue;
    t=f->arguments[0].type;
    if(!Expression_test_cast_to(type,t,flags,module,excluded,nb_excluded+1,&test_function,&test_type,&test_length,&test_nb)) continue;
    test_length+=1;
    if(test_length<*path_length) {
      *next_function=(test_function!=null ? test_function : f),*next_type=(test_type!=null ? test_type : t),*path_length=test_length,*path_nb=test_nb;
    orif(test_length==*path_length)
      *path_nb+=test_nb; } }
  Str_destroy(&name);
  return *path_nb==1; }


static struct Argument *Expression_apply_casting_function(struct Expression *e,struct Argument *arg,Int access,struct Function *f) {
  struct Argument *arg2; struct Instruction *i; Int a;
  check(f->nb_argres==2);
  check(e->result->type==f->arguments[0].type);
  if(e->uncasted_result==null) {
    Arrow_set((Arrow *)&e->last_uncasted_instruction,*List_last(&e->instructions));
    Arrow_copy((Arrow *)&e->result,(Arrow *)&e->uncasted_result);
    e->uncasted_access=e->access; }
  if(f->arguments[1].access&Access_mapped) {
    arg2=argument(f->arguments[1].type,Argument_indirect,argument(G.type_Address,Argument_local),0);
  other
    arg2=argument(f->arguments[1].type,Argument_local); }
  i=instruction(f,arg,arg2,END);
  Expression_add(e,i);
  a=f->arguments[1].access;
  Expression_set_result(e,arg2,
    (a&Access_result_read ? Access_read : 0)|
    (a&Access_result_write ? Access_write : 0)|
    (a&Access_object ? Access_object : 0)|
    (a&Access_result_consistent ? access&(Access_read|Access_write) : 0) );
  return arg2; }


FUNCTION struct Argument *Expression_cast3(struct Expression *e,struct Argument *arg,Int access,struct Type *wished_type,Int flags) {
  struct Type *excluded[16];
  struct Function *next_function; struct Type *next_type; Int next_length,next_nb;
  for(;;) {
    if(arg->type==wished_type) return arg;
    if(!Expression_test_cast_to(arg->type,wished_type,flags,e->module,excluded,0,&next_function,&next_type,&next_length,&next_nb)) return null;
    e->cast_level++,e->cast_flags=flags;
    if(next_function==null) return arg;
    arg=Expression_apply_casting_function(e,arg,access,next_function); } }

FUNCTION Bool Expression_cast2(struct Expression *e,struct Type *wished_type,Int cast_flags) {
  Expression_compile(e); if(error_notified()) return false;
  if(e->result->type==wished_type && (e->cast_level==0 || e->cast_flags==(Function_flag_implicit|Function_flag_extension))) return true;
  Expression_uncast(e);
  return Expression_cast3(e,e->result,e->access,wished_type,cast_flags)!=null; }

FUNCTION Bool Expression_cast(struct Expression *e,struct Type *wished_type) {
  return Expression_cast2(e,wished_type,Function_flag_implicit|Function_flag_extension); }


FUNCTION Void Expression_uncast(struct Expression *e) {
  struct Instruction *i;
  if(e->uncasted_result!=null) {
    Expression_rewind(e,e->last_uncasted_instruction);
    Arrow_copy((Arrow *)&e->uncasted_result,(Arrow *)&e->result);
    e->access=e->uncasted_access;
    Arrow_set((Arrow *)&e->uncasted_result,null); }
  e->cast_level=0; }


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


static Void execute(struct Function *function) {
  ((Void (*)())function->exe)(); }

static Void breakpoint() {}


FUNCTION Void _EXTERNAL_ Expression_execute(struct Expression *e) {
  struct GeneratorContext *gc; struct Function *function;
  struct Str name,s; struct ActionRecord ca;
  Arrow *c;
  #ifdef _TIMER_
    Int old;
    old=timer_set(timer_compile);
  #endif
  Expression_compile(e);
  if(error_notified()) {
    #ifdef _TIMER_
      timer_set(old);
    #endif
    return; }
  #ifdef _TIMER_
    timer_set(timer_optimize);
  #endif
  Expression_cut_backtracking(e); 
  gc=(struct GeneratorContext *)entry_new(G.type_GeneratorContext); entry_lock(gc);
  function=(struct Function *)entry_new(G.type_Function);
  Str_build(&name);
  string_Str("_noname_",&name);
  Str_copy(&name,&function->name);
  ListingPosition_copy(&e->position,&function->position);
  GeneratorContext_setup(gc,e,function);
  GeneratorContext_optimize(gc);
  if(!error_notified()) {
    Dictionary_insert2(G.general_dictionary,&name,true,function,G.unused_module);
    if(!error_notified()) {
      ActionRecord_build(&ca);
      Str_build(&s);
      ListingPosition_get(&e->position,&s);
      action_push_recordn(&ca,Z,"execute ",S,&s,END);
      Str_destroy(&s);
      for(c=List_first(G.execute_begin_hooks); c!=G.null_constant; c=List_next(c)) {
        check(entry_type(*c)==G.type_Function);
        ((ExecutionBeginPrototype)((struct Function *)*c)->exe)(function); } 
      #ifdef _i386_
        if(*(Byte *)function->exe!=0xC3) {
      #endif
        #ifdef _TIMER_
          timer_set(timer_execute);
        #endif
        execute(function);
      #ifdef _i386_
        }
      #endif
      for(c=List_first(G.execute_end_hooks); c!=G.null_constant; c=List_next(c)) {
        check(entry_type(*c)==G.type_Function);
        ((ExecutionEndPrototype)((struct Function *)*c)->exe)(function); } 
      action_pull_record(&ca);
      ActionRecord_destroy(&ca); }
    Dictionary_remove(G.general_dictionary,&name,function); }
  #ifdef _TIMER_
    timer_set(old);
  #endif
  entry_unlock(gc);
  Str_destroy(&name); }


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


FUNCTION Address Expression_evaluate2(struct Expression *e,struct Type *type,Int cast_flags) {
  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_Address,Argument_constant,entry(G.type_Address,result,END)),0);
    Expression_add(e,instruction(G.function_copy_universal,e->result,a,argument(G.type_Type,Argument_constant,type),END));
  other
    a=argument(G.type_Address,Argument_indirect,argument(G.type_Address,Argument_constant,entry(G.type_Address,&result,END)),0);
    Expression_add(e,instruction(G.function_arrow_universal,e->result,a,END)); }
  m=e->module; mark=Module_mark(m);
  Module_define(m,Str_map_string(&temp,"pliant function"),entry_new(G.type_Function));
  Module_define(m,Str_map_string(&temp,"pliant arguments"),entry_new(G.type_Array));
  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_constant ? e->result->u.constant : null); }


FUNCTION Address Expression_pure_ident(struct Expression *e) {
  if(e->arguments.nb==0 && entry_type(e->value)==G.type_Ident)
    return e->value;
  else
    return null; }


FUNCTION Address Expression_constant2(struct Expression *e,struct Type *wished_type,Int cast_flags) {
  struct Type *t; struct Expression *e2; Address cst;
  Bool should = e->arguments.nb==0 && entry_type(e->value)==wished_type;
  Expression_compile(e);  if(error_notified()) return null;
  if((e->access&Access_constant) && e->result->type==wished_type && List_first(&e->instructions)==G.null_constant && e->result->where==Argument_constant)
    return e->result->u.constant;
  Expression_uncast(e);
  if(error_notified() || !(e->access&Access_constant) || List_first(&e->instructions)!=G.null_constant)
    return null;
  if(!Expression_cast2(e,wished_type,cast_flags))
    return null;
  e2=(struct Expression *)entry_new(G.type_Expression); entry_lock(e2);
  Expression_copy(e,e2);
  cst=Expression_evaluate2(e,wished_type,cast_flags); check(cst!=null);
  if(e->result->type!=wished_type)
    Expression_copy(e2,e);
  entry_unlock(e2);
  return cst; }
  
FUNCTION Address Expression_constant(struct Expression *e,struct Type *wished_type) {
  return Expression_constant2(e,wished_type,Function_flag_implicit|Function_flag_extension); }

FUNCTION Address _EXTERNAL_ Expression_evaluate(struct Expression *e) {
  Address result;
  Expression_compile(e); if(error_notified()) return null;
  result=Expression_evaluate2(e,Type_real_data_type(e->result->type),Function_flag_implicit|Function_flag_extension);
  return result; }