Code coverage for switch.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        := SWITCH;

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


  - author      := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment     := "Switch for late binding resolution";

  // BSBS: Optim. : Détecter les switch identique l'un après l'autre
  // pour les fusionner...

Section Inherit

  + parent_instr:Expanded INSTR;

Section Public

  - is_invariant:BOOLEAN <-
  ( + result:BOOLEAN;
    + j:INTEGER;

    (expr.is_invariant).if {
      result := TRUE;
      j := list.lower;
      {(j <= list.upper)    {result}}.while_do {
	result := list.item j.code.is_invariant;
	j := j + 1;
      };
    };
    result
  );

  + expr:EXPR;

  + list:FAST_ARRAY(CASE);

  - count:INTEGER <- list.count;

  //
  // Creation.
  //

  - create n:NODE with e:EXPR size s:INTEGER :SELF <-
  [ -? {n.position != 0}; ]
  ( + result:SELF;

    result := clone;
    result.make n with e size s;
    result
  );


  - make n:NODE with e:EXPR size s:INTEGER <-
  ( + first:CASE;

    position := n.position;
    expr     := e;
    list     := FAST_ARRAY(CASE).create_with_capacity s;
    (n.first_code != NULL).if {
      first := CASE.create (n.first_type) with (n.first_code);
      list.add_last first;
    };
  );

  //
  // Copy.
  //

  - set_expr e:EXPR list l:FAST_ARRAY(CASE) <-
  (
    expr := e;
    list := l;
  );

  - my_copy:SELF <-
  ( + result:SELF;
    + new_list:FAST_ARRAY(CASE);

    new_list := FAST_ARRAY(CASE).create_with_capacity (list.count);
    (list.lower).to (list.upper) do { j:INTEGER;
      new_list.add_last (list.item j.my_copy);
    };

    result := clone;
    result.set_expr (expr.my_copy) list new_list;
    result
  );

  //
  // Remove.
  //

  - remove <-
  (
    (expr != NULL).if {
      expr.remove;
    };
    (list.lower).to (list.upper) do { j:INTEGER;
      list.item j.remove;
    };
  );

  //
  // Execute
  //

  - i_am_the_last i:INSTR :BOOLEAN <-
  ( + result:BOOLEAN;
    + j:INTEGER;

    j := list.lower;
    {(j <= list.upper)    {!result}}.while_do {
      result := list.item j.code.i_am_the_last i;
      j := j + 1;
    };
    result
  );

  - execute:INSTR <-
  ( + lst_typ:TYPES_TMP;
    + result:INSTR;
    + typ:TYPE;
    + wrt:WRITE;
    + lst:LIST;
    + tb:PROFIL_BLOCK;
    + is_end:BOOLEAN;
    + count_empty:INTEGER;

    // switch_fusion; // BSBS: A revoir assure toi que le receiver ne bouge pas!!!
                      // Rappel toi du step=0 ds cortex

    // Update.
    lst_typ := TYPES_TMP.new;
    // BSBS: optim a voir si necessaire ...
    /*
    (expr.static_type.is_strict).if {
      lst_typ.add (expr.static_type.raw);
    } else {
      */
      expr.get_type lst_typ;
    //};
    ? {lst_typ.count <= list.count};

    (lst_typ.count > list.count).if {
      "New type: ".print;
      lst_typ.print;
      "\nOld type: ".print;
      string_tmp.clear;
      list.lower.to (list.upper) do { j:INTEGER;
	list.item j.id.append_name_in string_tmp;
	string_tmp.add_last ',';
      };
      string_tmp.print;
      '\n'.print;
      /*
      string_tmp.clear;
      profil_current.display string_tmp;
      string_tmp.print;


      ( + wrt2:WRITE;
        + rd:READ;
        + var:VARIABLE;

        rd ?= expr;
        var := rd.variable;
        wrt2 := var.require_first;
        rd ?= wrt2.value;
        var := rd.variable;

        wrt2 := var.require_first;
        wrt2.debug_display;
        "==============\n".print;
        (var.require_list.lower).to (var.require_list.upper) do { i:INTEGER;
          "==============\n".print;
          i.print; '\n'.print;
          wrt2 := var.require_list.item i;
          wrt2.debug_display;
          (i = 2).if {
            warning_error (wrt2.position,"ICI");
          };
        };
      );*/
      syntax_error (expr.position,"*****SWITCH BUG********");
    };

    //
    // BSBS: Ajoute un pattern pour les elseif ...
    //
    (lst_typ.lower).to (lst_typ.upper) do { j:INTEGER;
      typ := lst_typ.item j;
      {typ = list.item j.id}.until_do {
	list.item j.remove;
        list.remove j;
      };
      (list.item j.code.is_empty).if {
        count_empty := count_empty + 1;
      };
    };
    {lst_typ.count = list.count}.until_do {
      list.last.remove;
      list.remove_last;
    };
    lst_typ.free;

    // Execute.
    (
      (list.count = 1) || {
	(list.count = 2)   
	{debug_level_option = 0}   
        {list.first.id = TYPE_NULL}   
        {! list.first.code.is_empty}   
        {
	  wrt ?= list.first.code.first; // For ?= with NULL type.
	  wrt = NULL
	}
      }
    ).if {
      result := expr.execute_unlink;
      (result != NULL).if {
	list_current.insert_before result;
      };
      tb ?= list.last.id;
      (tb != NULL).if {
	tb.dec_id;
      };
      result := list.last.code.execute;
      is_end := TRUE;
    }.elseif {count_empty = list.count} then {
      result := expr.execute_unlink;
      (list.lower).to (list.upper) do { j:INTEGER;
        list.item j.remove;
      };
      is_end := TRUE;
    };
    //
    (! is_end).if {
      // Normal execution.
      (
	(expr.static_type.raw = type_boolean)   
	{list.count = 2}   
	{list.first.code.is_empty}
      ).if {
	? {! list.second.code.is_empty};
	expr := EXPR_NOT_LOGIC.create (expr.position) with expr;
	lst := list.first.code;
	list.first .set_code (list.second.code);
	list.second.set_code lst;
      };
      /*
      seq_or_and := seq_or_and + 1;
      seq_inline := seq_inline + 1;
      */
      expr := expr.execute_link;

      CALL_SLOT.reset_count_no_recursive;
      ((list.first.id = TYPE_NULL)    {list.count = 2}).if {
	list.first .code.execute_case;
        list.second.code.execute_case;
        ((list.second.id.is_block)    {debug_level_option != 0}).if {
          list.second.id.set_late_binding;
        };
      } else {
	(list.lower).to (list.upper) do { j:INTEGER;
          list.item j.execute;
	};
      };
      result := detect_logic_expr;
      (result = NULL).if {
	result := Self;
      };
    };

    result
  );

  //
  // Genere.
  //

  - count_bug:INTEGER;

  - genere buffer:STRING <-
  ( + lst:LIST;
    + first_case:INTEGER;
    + typ_first:TYPE;
    + typ_id:TYPE_ID;
    + wrt:WRITE;
    + is_genered:BOOLEAN;
    + c1,c2:CASE;
    + lst_case:FAST_ARRAY(CASE);
    + cases:FAST_ARRAY(FAST_ARRAY(CASE));

    count_switch := count_switch + 1;
    (
      (list.first.id = TYPE_NULL)    
      {debug_level_option = 0}       
      {! list.first.code.is_empty}   
      {
	wrt ?= list.first.code.first; // For ?= with NULL type.
	wrt = NULL
      }
    ).if {
      list.remove_first;
    };
    typ_first := list.first.id;
    typ_id ?= typ_first;
    ((list.count <= 2) || {typ_first = TYPE_NULL}).if {
      buffer.append "if (";
      //
      ((expr.static_type.raw.is_block)    {typ_first = TYPE_NULL}).if {
        expr.genere buffer;
        is_genered := TRUE;
        buffer.append ".__id==0";
      } else {
        typ_first.put_access_id expr in buffer;
        is_genered := TRUE;
        (expr.static_type.raw != type_boolean).if {
          buffer.append "==";
          typ_first.put_id buffer;
        } else {
          ? {typ_first.name = ALIAS_STR.prototype_true};
        };
      };
      buffer.append ") ";
      //
      list.first.genere buffer;
      first_case := 1;
      //
      (list.count = 2).if {
        lst := list.second.code;
        (! list.second.code.is_empty).if {
          buffer.append " else ";
          buffer.append "/* ";
          buffer.append (list.second.id.name);
          buffer.append " */ ";
          list.second.genere buffer;
        };
        first_case := 2;
      }.elseif {list.count > 2} then {
        buffer.append " else {\n";
        indent.append "  ";
        buffer.append indent;
      };
    };
    (first_case <= list.upper).if {
      (is_genered).if {
        expr := expr.my_copy;
      };
      cases := case_fusion first_case;
      (cases.count = 2).if {
        (cases.first.count = 1).if {
          c1 := cases.first.first;
          c2 := cases.second.first;
        }.elseif {cases.second.count = 1} then {
          c1 := cases.second.first;
          c2 := cases.first.first;
        };
      };
      (c1 != NULL).if {
        buffer.append "if (";
        c1.id.put_access_id expr in buffer;
        buffer.append "==";
        c1.id.put_id buffer;
        buffer.append ") ";
        c1.genere buffer;
        buffer.append " else /* Other types */ ";
        c2.genere buffer;
      } else {
        polymorphic_counter := polymorphic_counter + 1;
        buffer.append "switch (";
        list.item first_case.id.put_access_id expr in buffer;
        buffer.append ") {\n";
        (cases.lower).to (cases.upper) do { j:INTEGER;
          lst_case := cases.item j;
          (! lst_case.first.code.is_empty).if {
            (lst_case.lower).to (lst_case.upper) do { i:INTEGER;
              buffer.append indent;
              buffer.append "case ";
              lst_case.item i.id.put_id buffer;
              buffer.append ": \n";
            };
            buffer.remove_last 1;
            lst_case.first.genere buffer;
            buffer.append " break;\n";
          }

          // Debug...
          else {
            (lst_case.lower).to (lst_case.upper) do { i:INTEGER;
              buffer.append indent;
              buffer.append "case ";
              lst_case.item i.id.put_id buffer;
              buffer.append ": \n";
            };
            buffer.remove_last 1;
            buffer.append " break;\n";
          };
        };
        // Debug...
        (debug_level_option != 0).if {
          buffer.append indent;
          buffer.append "default:\n";
          buffer.append indent;
          buffer.append "lisaac_stack_print(top_context); \
          \print_string(\"Call on twilight zone!!!\\n\"); \
          \die_with_code(1);\n";
        };

        buffer.append indent;
        buffer.add_last '}';
      };
      free_list_cases cases;
      (first_case != 0).if {
        buffer.add_last '\n';
        indent.remove_last 2;
        buffer.append indent;
        buffer.add_last '}';
      };
    };
  );

  //
  // Display.
  //

  - display buffer:STRING <-
  ( + line:{INTEGER; };

    line :=
    { j:INTEGER;
      + i:LIST;
      buffer.append indent;
      buffer.put '+' to (buffer.upper-1);
      buffer.put '-' to (buffer.upper);
      buffer.append (list.item j.id.intern_name);
      buffer.append ":\n";
      buffer.append indent;
      i := list.item j.code;
      (i = NULL).if {
	buffer.append "<Empty>";
      } else {
	i.display buffer;
      };
    };

    buffer.append "Switch ";
    expr.display buffer;
    buffer.add_last '\n';
    (list.count > 0).if {
      indent.append "| ";
      0.to (list.upper - 1) do { j:INTEGER;
	line.value j;
	buffer.add_last '\n';
      };
      indent.put ' ' to (indent.upper-1);
      line.value (list.upper);
      indent.remove_last 2;
    };
  );

  - switch_new_pass:BOOLEAN;
  - reset_switch_new_pass <-
  (
    switch_new_pass := FALSE;
  );

Section Private

  - detect_logic_expr:INSTR <-
  // Detection !, |,  , ||,    :
  ( + result:INSTR;
    + wr_true,wr_false:WRITE;
    + rd:READ;
    + val_true,val_false:EXPR;
    + a,b,c,d:BOOLEAN;

    (
      (expr.static_type.raw = type_boolean)   
      {list.count = 2}   
      {list.first.code.count  = 1}   
      {list.second.code.count = 1}
    ).if {
      ? {list.first.id  = type_true };
      ? {list.second.id = type_false};

      ((list.first.id != type_true) || {list.second.id != type_false}).if {
	syntax_error (position,"PB dans SWITCH.");
      };

      wr_true  ?= list.first .code.first;
      wr_false ?= list.second.code.first;
      (
	(wr_true  != NULL)   
	{wr_false != NULL}   
	{wr_true.static_type.raw = type_boolean}   
	{wr_true.variable = wr_false.variable}
      ).if {
	val_true  := wr_true .value;
	val_false := wr_false.value;
	// BSBS: val_true.static_type = type_true ???
	(
	  (a := val_true.is_constant)   
	  {b := (val_true.static_type.raw = type_true)}
	).if {
	  // | or ||
	  rd ?= val_false;
	  (rd != NULL).if {
	    // |
	    wr_true.remove;
	    val_false := EXPR_OR_LOGIC.create position with expr and val_false;
	    wr_false.set_value val_false;
	    result := wr_false;
	    new_execute_pass;
	  }.elseif {(CALL_SLOT.count_no_recursive = 0) || {modify_count = 0}} then {
	    // ||
	    wr_true.remove;
	    val_false := EXPR_OR_OR_LOGIC.create position with expr and val_false;
	    wr_false.set_value val_false;
	    result := wr_false;
	    switch_new_pass := TRUE;
	  };
	}.elseif {
	  (c := val_false.is_constant)   
	  {d := (val_false.static_type.raw = type_false)}
	} then {
	  //   or   
	  rd ?= val_true;
	  (rd != NULL).if {
	    //  
	    wr_false.remove;
	    val_true := EXPR_AND_LOGIC.create position with expr and val_true;
	    wr_true.set_value val_true;
	    result := wr_true;
	    new_execute_pass;
	  }.elseif {(CALL_SLOT.count_no_recursive = 0) || {modify_count = 0}} then {
	    //   
	    wr_false.remove;
	    val_true := EXPR_AND_AND_LOGIC.create position with expr and val_true;
	    wr_true.set_value val_true;
	    result := wr_true;
	    switch_new_pass := TRUE;
	  };
	}.elseif {
	  (a)    {!b}    {c}    {!d}
	} then {
	  // !
	  wr_false.remove;
	  wr_true.set_value (EXPR_NOT_LOGIC.create position with expr);
	  result := wr_true;
	  new_execute_pass;
	};
      };
    };
    result
  );

  - switch_fusion <-
  ( + other:SWITCH;
    + index:INTEGER;
    //+ wrt:WRITE;
    //+ rd,rd2:READ;

    index := list_current.index + 1;
    (index <= list_current.upper).if {
      other ?= list_current.item index;
      ((other != NULL)    {other.expr ~= expr}    {other.list.count = list.count}).if {
        concat_switch other;
        list_current.put NOP to index;
        //warning_error (position,"ICI");
      };
      /*
      (index < list_current.upper).if {
        // BSBS: Dans ce cas la, tu devrai en avoir 250 !!!!
        // Regarde pourquoi tu n'as que 14 cas !
        wrt ?= list_current.item index;
        rd  ?= expr;
        ((wrt != NULL)    {rd != NULL}    {wrt.variable != rd.variable}).if {
          rd2   ?= wrt.value;
          other ?= list_current.item (index + 1);
          ((rd2 != NULL)    {other != NULL}   
          {other.expr ~= expr}    {other.list.count = list.count}).if {
            count_switch_merging := count_switch_merging + 1;
            (list.lower).to (list.upper-1) do { j:INTEGER;
              list.item j.code.add_last (wrt.my_copy);
            };
            list.last.code.add_last wrt;
            list_current.put NOP to index;
            concat_switch other;
            list_current.put NOP to (index + 1);
          };
        };
      };
      */
    };
  );

  - concat_switch other:SWITCH <-
  ( + other_list:FAST_ARRAY(CASE);
    + code:LIST;

    other.expr.remove;
    other_list := other.list;
    (list.lower).to (list.upper) do { j:INTEGER;
      code := list.item j.code;
      code.add_last (other_list.item j.code);
    };
    new_execute_pass;
  );

  //
  // Case fusion manager.
  //

  - store_list_cases:FAST_ARRAY(FAST_ARRAY(FAST_ARRAY(CASE))) :=
  FAST_ARRAY(FAST_ARRAY(FAST_ARRAY(CASE))).create_with_capacity 32;

  - store_cases:FAST_ARRAY(FAST_ARRAY(CASE)) :=
  FAST_ARRAY(FAST_ARRAY(CASE)).create_with_capacity 32;

  - new_cases:FAST_ARRAY(CASE) <-
  ( + result:FAST_ARRAY(CASE);
    (store_cases.is_empty).if {
      result := FAST_ARRAY(CASE).create_with_capacity 32;
    } else {
      result := store_cases.last;
      store_cases.remove_last;
    };
    result
  );

  - new_list_cases:FAST_ARRAY(FAST_ARRAY(CASE)) <-
  ( + result:FAST_ARRAY(FAST_ARRAY(CASE));
    (store_list_cases.is_empty).if {
      result := FAST_ARRAY(FAST_ARRAY(CASE)).create_with_capacity 32;
    } else {
      result := store_list_cases.last;
      store_list_cases.remove_last;
    };
    result
  );

  - free_list_cases l:FAST_ARRAY(FAST_ARRAY(CASE)) <-
  ( + lst:FAST_ARRAY(CASE);
    (l.lower).to (l.upper) do { i:INTEGER;
      lst := l.item i;
      lst.clear;
      store_cases.add_last lst;
    };
    l.clear;
    store_list_cases.add_last l;
  );

  - case_fusion low:INTEGER :FAST_ARRAY(FAST_ARRAY(CASE)) <-
  ( + c1,c2:CASE;
    + lst:FAST_ARRAY(CASE);
    + j:INTEGER;
    + result:FAST_ARRAY(FAST_ARRAY(CASE));

    result := new_list_cases;
    (low).to (list.upper) do { i:INTEGER;
      c1 := list.item i;
      lst := NULL;
      j := result.lower;
      {(j <= result.upper)    {lst = NULL}}.while_do {
        c2 := result.item j.first;
        (c1 ~= c2).if {
          lst := result.item j;
          c1.code.remove;
        };
        j := j + 1;
      };
      (lst = NULL).if {
        lst := new_cases;
        result.add_last lst;
      };
      lst.add_last c1;
    };
    result
  );