///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Compiler                               //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   This program is free software: you can redistribute it and/or modify    //
//   it under the terms of the GNU General Public License as published by    //
//   the Free Software Foundation, either version 3 of the License, or       //
//   (at your option) any later version.                                     //
//                                                                           //
//   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       //
//   along with this program.  If not, see <http://www.gnu.org/licenses/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header
  
  + name        := ITM_EXTERNAL;

  - copyright   := "2003-2007 Benoit Sonntag";

  
  - author      := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment     := "External C without type result";
  
Section Inherit
  
  + parent_itm_extern:Expanded ITM_EXTERN;
  
Section Public

  //
  // Constructor
  //
  
  - create p:POSITION text n:STRING_CONSTANT :SELF <-
  ( + result:SELF;
    result := clone;
    result.make p text n;
    result
  );
  
  - make p:POSITION text n:STRING_CONSTANT <-
  (
    position := p;
    extern   := n;
  );

  //
  // Runnable
  //
  
  - to_run_expr:EXPR <- 
  ( + result:EXPR;
    + lst_acc:FAST_ARRAY[EXPR];
    + num:INTEGER;
    + exp1,exp2,exp3:EXPR;
    + left,right:EXPR;
    + type:TYPE_FULL;
        
    extern.is_integer.if {
      num := extern.to_integer;
      (num > 15).if {
	syntax_error (position,"Unknown external lisaac code (0..15).");
      };
      num
      .when 0 then { // is_expanded_type:BOOLEAN
	exp1 := profil_first.argument_list.first.read position;
	result := IS_EXPANDED.create position receiver exp1;
      }
      .when 1 then { // type_id_intern:INTEGER
	exp1 := profil_first.argument_list.first.read position;
	result := GET_TYPE_ID.create position receiver exp1;
      }
      .when 2 then { // INTEGER > INTEGER -> BOOLEAN.
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_SUP.create position with left and right;
      }
      .when 3 then { // INTEGER - INTEGER -> INTEGER.
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_SUB.create position with left and right;	
      }
      .when 4 then { // INTEGER * INTEGER -> INTEGER.
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_MUL.create position with left and right;		
      }
      .when 5 then { // INTEGER / INTEGER -> INTEGER.	
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_DIV.create position with left and right;		
      }
      .when 6 then { // INTEGER & INTEGER -> INTEGER.
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_AND.create position with left and right;		
      }
      .when 7 then { // INTEGER >> INTEGER -> INTEGER.
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_SHIFT_R.create position with left and right;		
      }
      .when 8 then { // INTEGER << INTEGER -> INTEGER.
	left   := profil_first.argument_list.first .read position;
	right  := profil_first.argument_list.item 1.read position;
	result := EXPR_SHIFT_L.create position with left and right;		
      }
      .when 9 then { // put OBJECT to INTEGER.
	exp1 := profil_first.argument_list.first .read position;
	exp2 := profil_first.argument_list.item 1.read position; 
	exp3 := profil_first.argument_list.item 2.read position; 
	result := PUT_TO.create position base exp1 index exp3 value exp2;
      }
      .when 10 then { // item INTEGER -> OBJECT.
	exp1 := profil_first.argument_list.first .read position;
	exp2 := profil_first.argument_list.item 1.read position; 
	result := ITEM.create position base exp1 index exp2;
      }      
      .when 11 then { // debug_level -> INTEGER.
	result := INTEGER_CST.create position value debug_level_option type (type_integer.default);
      }
      .when 12 then { // object_size -> INTEGER.	
	exp1 := profil_first.argument_list.first.read position;
	result := SIZE_OF.create position receiver exp1;
      }
      .when 13 then { // CONVERT[SRC to DST].on src:SRC :DST.
	type := profil_first.result_last.type;
	exp2 := profil_first.argument_list.second.read position;
	result := CAST.create type value exp2;
      }
      .when 14 then { // top_runtime_stack -> POINTER.
	(debug_level_option = 0).if {
	  result := PROTOTYPE_CST.create position type (TYPE_NULL.default);
	} else {
	  result := EXTERNAL_C.create position text "top_context->back->back"
	  access NULL persistant FALSE type (type_pointer.default);
	};
      }
      .when 15 then { // Free. (Nothing).
	syntax_error (position,"External Lisaac #15 : Free.");
      };            
    } else {
      lst_acc := get_access;
      result  := EXTERNAL_C.create position text last_code 
      access lst_acc persistant TRUE type (TYPE_VOID.default);
    };
    result
  );
  
