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
  )
;