
(********************************************************************)
(*                                                                  *)
(*  bst_act.s7i   Generate code for actions of the type bstring.    *)
(*  Copyright (C) 1990 - 1994, 2004 - 2014  Thomas Mertes           *)
(*                                                                  *)
(*  This file is part of the Seed7 compiler.                        *)
(*                                                                  *)
(*  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 2 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, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


const ACTION: BST_APPEND    is action "BST_APPEND";
const ACTION: BST_CMP       is action "BST_CMP";
const ACTION: BST_CPY       is action "BST_CPY";
const ACTION: BST_EQ        is action "BST_EQ";
const ACTION: BST_HASHCODE  is action "BST_HASHCODE";
const ACTION: BST_IDX       is action "BST_IDX";
const ACTION: BST_LNG       is action "BST_LNG";
const ACTION: BST_NE        is action "BST_NE";
const ACTION: BST_PARSE1    is action "BST_PARSE1";
const ACTION: BST_STR       is action "BST_STR";
const ACTION: BST_VALUE     is action "BST_VALUE";


const proc: bst_prototypes (inout file: c_prog) is func

  begin
    declareExtern(c_prog, "void        bstAppend (bstriType *const, const_bstriType);");
    declareExtern(c_prog, "bstriType   bstCat (const_bstriType, const_bstriType);");
    declareExtern(c_prog, "intType     bstCmp (const const_bstriType, const const_bstriType);");
    declareExtern(c_prog, "intType     bstCmpGeneric (const genericType, const genericType);");
    declareExtern(c_prog, "void        bstCpy (bstriType *const, const const_bstriType);");
    declareExtern(c_prog, "void        bstCpyGeneric (genericType *const, const genericType);");
    declareExtern(c_prog, "bstriType   bstCreate (const const_bstriType);");
    declareExtern(c_prog, "genericType bstCreateGeneric (const genericType);");
    declareExtern(c_prog, "void        bstDestr (const const_bstriType);");
    declareExtern(c_prog, "void        bstDestrGeneric (const genericType);");
    declareExtern(c_prog, "intType     bstHashCode (const const_bstriType);");
    declareExtern(c_prog, "bstriType   bstParse (const const_striType);");
    declareExtern(c_prog, "striType    bstStr (const const_bstriType);");
    declareExtern(c_prog, "bstriType   bstValue (const const_objRefType);");
  end func;


const proc: process (BST_APPEND, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  local
    var expr_type: c_param1 is expr_type.value;
    var expr_type: c_param3 is expr_type.value;
  begin
    process_expr(params[1], c_param1);
    c_param3.temp_num := c_param1.temp_num;
    getAnyParamToExpr(params[3], c_param3);
    if has_temp_values(c_param3) then
      c_expr.expr &:= "{\n";
      appendWithDiagnostic(c_param1.temp_decls, c_expr);
      appendWithDiagnostic(c_param3.temp_decls, c_expr);
      appendWithDiagnostic(c_param1.temp_assigns, c_expr);
      appendWithDiagnostic(c_param3.temp_assigns, c_expr);
    end if;
    setDiagnosticLine(c_expr);
    c_expr.expr &:= "bstAppend(&(";
    c_expr.expr &:= c_param1.expr;
    c_expr.expr &:= "), ";
    c_expr.expr &:= c_param3.expr;
    c_expr.expr &:= ");\n";
    if has_temp_values(c_param3) then
      appendWithDiagnostic(c_param1.temp_frees, c_expr);
      appendWithDiagnostic(c_param3.temp_frees, c_expr);
      c_expr.expr &:= "}\n";
    end if;
  end func;


const proc: process (BST_CMP, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "bstCmp(";
    getAnyParamToExpr(params[1], c_expr);
    c_expr.expr &:= ", ";
    getAnyParamToExpr(params[2], c_expr);
    c_expr.expr &:= ")";
  end func;


const proc: process (BST_CPY, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  local
    var expr_type: c_param1 is expr_type.value;
    var expr_type: c_param3 is expr_type.value;
  begin
    process_expr(params[1], c_param1);
    c_param3.temp_num := c_param1.temp_num;
    process_expr(params[3], c_param3);
    if has_temp_values(c_param3) then
      c_expr.expr &:= "{\n";
      appendWithDiagnostic(c_param1.temp_decls, c_expr);
      appendWithDiagnostic(c_param3.temp_decls, c_expr);
      appendWithDiagnostic(c_param1.temp_assigns, c_expr);
      appendWithDiagnostic(c_param3.temp_assigns, c_expr);
    end if;
    if c_param3.result_expr <> "" then
      c_expr.expr &:= "{\n";
      setDiagnosticLine(c_expr);
      if isNormalVariable(params[1]) then
        c_expr.expr &:= "bstriType old_bstri=";
        c_expr.expr &:= c_param1.expr;
        c_expr.expr &:= ";\n";
        setDiagnosticLine(c_expr);
        c_expr.expr &:= c_param1.expr;
        c_expr.expr &:= "=";
      else
        c_expr.expr &:= "bstriType *bstri_ptr=&(";
        c_expr.expr &:= c_param1.expr;
        c_expr.expr &:= ");\n";
        setDiagnosticLine(c_expr);
        c_expr.expr &:= "bstriType old_bstri=*bstri_ptr;\n";
        setDiagnosticLine(c_expr);
        c_expr.expr &:= "*bstri_ptr=";
      end if;
      c_expr.expr &:= c_param3.result_expr;
      c_expr.expr &:= ";\n";
      setDiagnosticLine(c_expr);
      c_expr.expr &:= "bstDestr(old_bstri);\n";
      c_expr.expr &:= "}\n";
    else
      setDiagnosticLine(c_expr);
      c_expr.expr &:= "bstCpy(&(";
      c_expr.expr &:= c_param1.expr;
      c_expr.expr &:= "), ";
      c_expr.expr &:= c_param3.expr;
      c_expr.expr &:= ");\n";
    end if;
    if has_temp_values(c_param3) then
      appendWithDiagnostic(c_param1.temp_frees, c_expr);
      appendWithDiagnostic(c_param3.temp_frees, c_expr);
      c_expr.expr &:= "}\n";
    end if;
  end func;


const proc: process (BST_EQ, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  local
    var string: bstri_a_name is "";
    var string: bstri_b_name is "";
  begin
    c_expr.expr &:= "(";
    bstri_a_name := getParameterAsVariable("const_bstriType", "tmp_a_", params[1], c_expr);
    bstri_b_name := getParameterAsVariable("const_bstriType", "tmp_b_", params[3], c_expr);
    (* Formula used: (a->size==b->size&&memcmp(a->mem,b->mem,
                     a->size*sizeof(unsigned char))==0) *)
    c_expr.expr &:= bstri_a_name;
    c_expr.expr &:= "->size==";
    c_expr.expr &:= bstri_b_name;
    c_expr.expr &:= "->size&&memcmp(";
    c_expr.expr &:= bstri_a_name;
    c_expr.expr &:= "->mem,";
    c_expr.expr &:= bstri_b_name;
    c_expr.expr &:= "->mem,";
    c_expr.expr &:= bstri_a_name;
    c_expr.expr &:= "->size*sizeof(unsigned char))==0)";
  end func;


const proc: process (BST_HASHCODE, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "bstHashCode(";
    getAnyParamToExpr(params[1], c_expr);
    c_expr.expr &:= ")";
  end func;


const proc: process_const_bst_idx (in bstring: bstri,
    in reference: index, inout expr_type: c_expr) is func

  local
    var reference: evaluatedParam is NIL;
    var integer: index_value is 0;
    var string: index_name is "";
  begin
    incr(countOptimizations);
    if getConstant(index, INTOBJECT, evaluatedParam) then
      index_value := getValue(evaluatedParam, integer);
      if index_value < 1 or index_value > length(bstri) then
        warning(DOES_RAISE, "INDEX_ERROR", c_expr);
        c_expr.expr &:= intRaiseError("INDEX_ERROR");
      else
        c_expr.expr &:= charLiteral(bstri[index_value]);
      end if;
    else
      c_expr.expr &:= "(";
      c_expr.expr &:= bstriLiteral(bstri);
      c_expr.expr &:= ")->mem[";
      if bstring_index_check then
        incr(countIndexChecks);
        incr(c_expr.temp_num);
        index_name := "idx_" & str(c_expr.temp_num);
        if ccConf.TWOS_COMPLEMENT_INTTYPE then
          c_expr.temp_decls &:= "uintType ";
        else
          c_expr.temp_decls &:= "intType ";
        end if;
        c_expr.temp_decls &:= index_name;
        c_expr.temp_decls &:= ";\n";
        c_expr.expr &:= "(";
        c_expr.expr &:= index_name;
        c_expr.expr &:= "=";
        if ccConf.TWOS_COMPLEMENT_INTTYPE then
          c_expr.expr &:= "(uintType)(";
          process_expr(index, c_expr);
          c_expr.expr &:= ")-1, idxChk(";
          c_expr.expr &:= index_name;
          c_expr.expr &:= ">=";
        else
          process_expr(index, c_expr);
          c_expr.expr &:= ", idxChk(";
          c_expr.expr &:= index_name;
          c_expr.expr &:= "<=0 || ";
          c_expr.expr &:= index_name;
          c_expr.expr &:= ">";
        end if;
        c_expr.expr &:= integerLiteral(length(bstri));
        c_expr.expr &:= ") ? ";
        c_expr.expr &:= intRaiseError("INDEX_ERROR");
        c_expr.expr &:= " : ";
        c_expr.expr &:= index_name;
        if ccConf.TWOS_COMPLEMENT_INTTYPE then
          c_expr.expr &:= ")";
        else
          c_expr.expr &:= "-1)";
        end if;
      else
        incr(countNoIndexChecks);
        c_expr.expr &:= "(";
        process_expr(index, c_expr);
        c_expr.expr &:= ")-1";
      end if;
      c_expr.expr &:= "]";
    end if;
  end func;


const proc: process_const_bst_idx (in reference: param1,
    in integer: index, inout expr_type: c_expr) is func

  local
    var string: bstri_name is "";
  begin
    incr(countOptimizations);
    if index < 1 then
      warning(DOES_RAISE, "INDEX_ERROR", c_expr);
      c_expr.expr &:= intRaiseError("INDEX_ERROR");
    elsif bstring_index_check then
      incr(countIndexChecks);
      c_expr.expr &:= "(";
      bstri_name := getParameterAsVariable("const_bstriType", "tmp_", param1, c_expr);
      c_expr.expr &:= bstri_name;
      c_expr.expr &:= "->mem[(idxChk(";
      c_expr.expr &:= bstri_name;
      c_expr.expr &:= "->size<";
      c_expr.expr &:= integerLiteral(index);
      c_expr.expr &:= ") ? ";
      c_expr.expr &:= intRaiseError("INDEX_ERROR");
      c_expr.expr &:= " : ";
      c_expr.expr &:= integerLiteral(pred(index));
      c_expr.expr &:= ")])";
    else
      incr(countNoIndexChecks);
      c_expr.expr &:= "(";
      getAnyParamToExpr(param1, c_expr);
      c_expr.expr &:= ")->mem[";
      c_expr.expr &:= integerLiteral(pred(index));
      c_expr.expr &:= "]";
    end if;
  end func;


const proc: process (BST_IDX, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  local
    var reference: evaluatedParam is NIL;
    var string: bstri_name is "";
    var string: index_name is "";
  begin
    if getConstant(params[1], BSTRIOBJECT, evaluatedParam) then
      process_const_bst_idx(getValue(evaluatedParam, bstring), params[3], c_expr);
    elsif getConstant(params[3], INTOBJECT, evaluatedParam) then
      process_const_bst_idx(params[1], getValue(evaluatedParam, integer), c_expr);
    elsif bstring_index_check then
      incr(countIndexChecks);
      incr(c_expr.temp_num);
      index_name := "idx_" & str(c_expr.temp_num);
      if ccConf.TWOS_COMPLEMENT_INTTYPE then
        c_expr.temp_decls &:= "uintType ";
      else
        c_expr.temp_decls &:= "intType ";
      end if;
      c_expr.temp_decls &:= index_name;
      c_expr.temp_decls &:= ";\n";
      c_expr.expr &:= "(";
      bstri_name := getParameterAsVariable("const_bstriType", "tmp_", params[1], c_expr);
      c_expr.expr &:= bstri_name;
      c_expr.expr &:= "->mem[(";
      c_expr.expr &:= index_name;
      c_expr.expr &:= "=";
      if ccConf.TWOS_COMPLEMENT_INTTYPE then
        c_expr.expr &:= "(uintType)(";
        process_expr(params[3], c_expr);
        c_expr.expr &:= ")-1, idxChk(";
        c_expr.expr &:= index_name;
        c_expr.expr &:= ">=";
      else
        process_expr(params[3], c_expr);
        c_expr.expr &:= ", idxChk(";
        c_expr.expr &:= index_name;
        c_expr.expr &:= "<=0 || ";
        c_expr.expr &:= index_name;
        c_expr.expr &:= ">";
      end if;
      c_expr.expr &:= bstri_name;
      c_expr.expr &:= "->size) ? ";
      c_expr.expr &:= intRaiseError("INDEX_ERROR");
      c_expr.expr &:= " : ";
      c_expr.expr &:= index_name;
      if ccConf.TWOS_COMPLEMENT_INTTYPE then
        c_expr.expr &:= ")])";
      else
        c_expr.expr &:= "-1)])";
      end if;
    else
      incr(countNoIndexChecks);
      c_expr.expr &:= "(";
      getAnyParamToExpr(params[1], c_expr);
      c_expr.expr &:= ")->mem[(";
      process_expr(params[3], c_expr);
      c_expr.expr &:= ")-1]";
    end if;
  end func;


const proc: process (BST_LNG, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "(intType)((";
    getAnyParamToExpr(params[1], c_expr);
    c_expr.expr &:= ")->size)";
  end func;


const proc: process (BST_NE, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  local
    var string: bstri_a_name is "";
    var string: bstri_b_name is "";
  begin
    c_expr.expr &:= "(";
    bstri_a_name := getParameterAsVariable("const_bstriType", "tmp_a_", params[1], c_expr);
    bstri_b_name := getParameterAsVariable("const_bstriType", "tmp_b_", params[3], c_expr);
    (* Formula used: (a->size!=b->size||memcmp(a->mem,b->mem,
                     a->size*sizeof(unsigned char))!=0) *)
    c_expr.expr &:= bstri_a_name;
    c_expr.expr &:= "->size!=";
    c_expr.expr &:= bstri_b_name;
    c_expr.expr &:= "->size||memcmp(";
    c_expr.expr &:= bstri_a_name;
    c_expr.expr &:= "->mem,";
    c_expr.expr &:= bstri_b_name;
    c_expr.expr &:= "->mem,";
    c_expr.expr &:= bstri_a_name;
    c_expr.expr &:= "->size*sizeof(unsigned char))!=0)";
  end func;


const proc: process (BST_PARSE1, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  begin
    prepare_bstri_result(c_expr);
    c_expr.result_expr := "bstParse(";
    getAnyParamToResultExpr(params[1], c_expr);
    c_expr.result_expr &:= ")";
  end func;


const proc: process (BST_STR, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  begin
    prepare_stri_result(c_expr);
    c_expr.result_expr := "bstStr(";
    getAnyParamToResultExpr(params[1], c_expr);
    c_expr.result_expr &:= ")";
  end func;


const proc: process (BST_VALUE, in reference: function,
    in ref_list: params, inout expr_type: c_expr) is func

  begin
    prepare_bstri_result(c_expr);
    c_expr.result_expr := "bstValue(";
    getStdParamToResultExpr(params[1], c_expr);
    c_expr.result_expr &:= ")";
  end func;
