Code coverage for expr.li

///////////////////////////////////////////////////////////////////////////////
//                             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    := EXPR;

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


  - author  := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment := "Parent for all expression";

Section Inherit

  + parent_instr:Expanded INSTR;

Section Public

  - cardinality:INTEGER <- 1;

  //
  // Comparison.
  //

  - Self:SELF '~=' Right 60 other:EXPR :BOOLEAN <- FALSE;

  - Self:SELF '!~=' Right 60 other:EXPR :BOOLEAN <- ! (Self ~= other);

  //
  // Type.
  //

  - static_type:TYPE_FULL <-
  (
    deferred;
    NULL
  );

  - get_type t:TYPES_TMP <- deferred;

  //
  // Flag.
  //

  - is_constant:BOOLEAN <- FALSE;

  //
  // Check type.
  //

  - check_type t:TYPE_FULL with p:POSITION :EXPR <-
  ( + result:EXPR;
    + local:VARIABLE;
    + instr:INSTR;
    + rec:EXPR;
    + slot_name:STRING_CONSTANT;
    + slot_msg:SLOT;
    + node:NODE;
    + args:FAST_ARRAY(EXPR);
    + ts:ITM_TYPE_SIMPLE;

    ? {static_type != NULL};
    ? {t != NULL};

    (t.affect_with static_type).if {
      result := Self;
    } else {
      ? {list_current != NULL};
      (static_type.is_export_to t).if {
	// Auto-export.
	local := static_type.get_temporary position;
	instr := local.write position value Self;
	list_current.add_last instr;
	//
	slot_name := ALIAS_STR.get (TYPE.last_cast_name);
	slot_msg  := static_type.get_slot slot_name;
	(slot_msg = NULL).if {
	  string_tmp.clear;
	  static_type.append_name_in string_tmp;
	  string_tmp.append " -> ";
	  t.append_name_in string_tmp;
	  string_tmp.append ". Slot `";
	  string_tmp.append slot_name;
	  string_tmp.append "' not found in `";
	  static_type.append_name_in string_tmp;
	  string_tmp.append "'.";
	  POSITION.put_error semantic text string_tmp;
	  p.put_position;
	  static_type.prototype.position.put_position;
	  POSITION.send_error;
	  //semantic_error p,string_tmp;
	};
	(slot_msg.argument_count != 1).if {
	  semantic_error (slot_msg.position,"No argument for this slot.");
	};
        ts ?= slot_msg.result_type;
	((ts = NULL) || {ts.to_run_for (t.raw) != t}).if {
          string_tmp.copy "Type result `";
          slot_msg.result_type.append_in string_tmp;
	  string_tmp.append "' is incorrect (Used for auto-conversion to `";
	  t.append_name_in string_tmp;
	  string_tmp.append "').";
	  POSITION.put_error semantic text string_tmp;
	  slot_msg.position.put_position;
	  position.put_position;
	  POSITION.send_error;
	};
	//
	rec  := local.read position;
	node := NODE.new_read position slot slot_msg
        receiver rec self rec intern FALSE;
	list_current.add_last node;
	//
	result := node.result_expr;
      }.elseif {t.is_import_to static_type} then {
        // Auto-import.
	local := static_type.get_temporary position;
	instr := local.write position value Self;
	list_current.add_last instr;
	//
	slot_name := ALIAS_STR.get (TYPE.last_cast_name);
	slot_msg  := t.get_slot slot_name;
	(slot_msg = NULL).if {
	  string_tmp.clear;
	  t.append_name_in string_tmp;
	  string_tmp.append " <- ";
	  static_type.append_name_in string_tmp;
	  string_tmp.append ". Slot `";
	  string_tmp.append slot_name;
	  string_tmp.append "' not found in `";
	  t.append_name_in string_tmp;
	  string_tmp.append "'.";
	  POSITION.put_error semantic text string_tmp;
	  p.put_position;
	  t.prototype.position.put_position;
	  POSITION.send_error;
	  //semantic_error p,string_tmp;
	};
	(slot_msg.argument_count != 2).if {
	  semantic_error (slot_msg.position,"Incorrect argument for this slot.");
	};
        ts ?= slot_msg.result_type;
	((ts = NULL) || {ts != ITM_TYPE_PARAMETER.type_self}).if {
	  string_tmp.copy "Type result `";
          slot_msg.result_type.append_in string_tmp;
	  string_tmp.append "' is incorrect (Used for auto-conversion to `";
	  t.append_name_in string_tmp;
	  string_tmp.append "').";
	  POSITION.put_error semantic text string_tmp;
	  slot_msg.position.put_position;
	  position.put_position;
	  POSITION.send_error;
	};
	//
	args := FAST_ARRAY(EXPR).create_with_capacity 2;
	args.add_last (PROTOTYPE_CST.create position type t);
	args.add_last (local.read position);
	node := NODE.new_read position slot slot_msg
        receiver (args.first.my_copy) with args intern FALSE;
	list_current.add_last node;
	//
	result := node.result_expr;
      } else {
        // Type Error
	string_tmp.copy "Type `";
	t.append_name_in string_tmp;
	string_tmp.append "' is invalid with `";
	static_type.append_name_in string_tmp;
	string_tmp.append "'.";
	POSITION.put_error semantic text string_tmp;
	p.put_position;
        position.put_position;
	POSITION.send_error;
      };
    };
    result
  );

  //
  // Execute.
  //

  - execute:INSTR <-
  (
    execute_unlink
  );

  - execute_link:EXPR <-
  (
    deferred;
    NULL
  );
  //[ ? {Result != NULL}; ];

  - execute_unlink:INSTR <-
  (
    deferred;
    NULL
  );